Recuperation sur autre feuille

[AL]

Bonsoir le forum

Sur un de mes précedent Post, Celeda m' a fournit un lien sur lequel j' ai récuperer ce fichier pour lister des fichiers, mais le pb c' est qu' il liste les fichiers sur la feuille des parametresn et j' aimereais qu' il construise la liste
sur la feuille suivante ( les xls sur une feuillen les *.doc sur une autre feuille)
Merci à tous ceux qui pourront m' aider à remodeler ce fichier


AL

 

[Zon]

Re:

Salut,

Ceci devrait te faire l'affaire à mettre dans un module classique:

Const L as Byte=1 'à adapter
Sub Princ()
Dim TXL, TDOC, Rep$, Hwnd As Long
Hwnd = FindWindow32("XLMAIN", Application.Caption)
Rep = BrowseForFolder(Hwnd, "Parcourir...")
TXL = ChercheFichier("*.xls", Rep, False) 'mettre true pour les sous repertoire
TDOC = ChercheFichier("*.doc", Rep, False)
RempF TXL, Sheets(2)
RempF TDOC, Sheets(3)
End Sub

Private Function ChercheFichier(Extension$, Rep$, Optional Sourep As Boolean)
Dim I As Long, Tablo
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = Rep
.Filename = Extension
.SearchSubFolders = Sourep
.Execute
ReDim Tablo(1 To .FoundFiles.Count, 1 To 3)
For I = 1 To .FoundFiles.Count
Tablo(I, 1) = .FoundFiles(I)
Tablo(I, 2) = FileLen(.FoundFiles(I))
Tablo(I, 3) = FileDateTime(.FoundFiles(I))
Next I
End With
On Error GoTo 0
ChercheFichier = Tablo
End Function

Private Sub RempF(T, F As Worksheet)
With F
.Cells.ClearContents
.Range("A" & L) = "Chemin fichier"
.Range("B" & L) = "Taille"
.Range("C" & L) = "Date/Heure"
If IsArray(T) Then
.Range("A" & L + 1).Resize(UBound(T, 1), UBound(T, 2)) = T
Else: .Range("A" & L + 1) = "rien trouvé"
End If
End With
End Sub

A+++

Ps quelle galère le forum ce soir..

 

[Celeda]

Bonsoir,

Ouf........Zorro est passé par là !! tant mieux AL car avec moi tu aurais pu passer la nuit à comprendre les sommeprod et les tcd mais ça ................
même sur une ile deserte.......................on y serait pas arrivé...... en une nuit.....lol!!



merci Zon

 

[AL]

Bonjour le forum

Merci Zon, j' ai installé et tester la macro, elle fonctionne sans PB et me donne les résultats que j' attendais.


AL