1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
| Option Explicit
Public nb As Integer
Dim Tableau()
Sub Appel()
Dim chemin As String
nb = 0
chemin = "C:\APT\PROGRAM\LIGNES\UNITS"
Lister chemin
End Sub
Public Function Lister(chemin As String)
Dim fs, Rep As Variant, NewRep As String, Nomfich As String
Set fs = CreateObject("Scripting.FileSystemObject")
Lister = fs.GetFolder(chemin).Files.Count
Nomfich = Dir(chemin & "\*.sfc")
Do While Nomfich <> ""
nb = nb + 1
Cells(nb, 10) = chemin & "\" & Nomfich 'liste dans la feuille de calculs active
Nomfich = Dir()
Loop
For Each Rep In fs.GetFolder(chemin).SubFolders
NewRep = Lister(Rep.Path)
Next Rep
Dim Temp As String, Ligne, Z, Colonne As Integer
Z = 1
Ligne = 1
Colonne = 1
Temp = Dir("C:\APT\PROGRAM\LIGNES\UNITS\*.", vbDirectory)
Do
ReDim Preserve Tableau(1 To Z)
If Temp = "" Then
Exit Do
ElseIf Temp = "." Or Temp = ".." Then
'Ne rien afficher
Else
Cells(Ligne, Colonne) = Temp
Ligne = Ligne + 1
Tableau(Z) = Temp
Z = Z + 1
End If
Temp = Dir
Loop
Dim DernièreLigneUnits, DernièreLigneFichiers As Variant
Dim i, j, PosSlash, PointeurColFichiers, k, NomFichier As Integer
Range("A1").Select
DernièreLigneUnits = ActiveCell.End(xlDown).Row
Range("J1").Select
DernièreLigneFichiers = ActiveCell.End(xlDown).Row
For i = 1 To DernièreLigneUnits
PointeurColFichiers = 0
For j = 1 To DernièreLigneFichiers
PosSlash = 0
For k = 1 To 6
PosSlash = InStr(PosSlash + 1, Range("j" & CStr(j)), "\")
Next k
NomFichier = Left(Range("j" & CStr(j)), PosSlash)
If InStr(1, NomFichier, Range("A" & CStr(i))) <> 0 Then
Range(Chr(67 + PointeurColFichiers) & CStr(i)) = Range("j" & CStr(j))
PointeurColFichiers = PointeurColFichiers + 1
End If
Next j
Next i
End Function |
Partager