Private Sub BtnLister_Click()
'Ou en cliquant sur ce bouton
Call Test
End Sub
Private Sub ListBox1_Click()
If ListBox1.ListIndex <> -1 Then
Workbooks.Open FileName:=ThisWorkbook.Path & "\Dossier_Factures\" & ListBox1.Text
Unload Me
End If
End Sub
Sub Test()
Const ssfTous = &H1
Dim objShell As Object, objFolder As Object, oFolderItem As Object
'Ici le ThisWorkbook est le chemin de ce fichier
Chemin = ThisWorkbook.Path & "\Dossier_Factures"
UserForm2.ListBox1.Clear
UserForm2.Label1.Caption = Chemin
Lister 1, UserForm2.Label1.Caption
End Sub
Sub Lister(nRow&, FolderName$, Optional Suffix$ = "*.*", Optional SubDir As Boolean = True)
Dim i As Long, x As Long, File As String, Folder As String, nbFolders() As String
Application.ScreenUpdating = False
nRow = nRow + 1
If Not Right(FolderName, 1) = "\" Then FolderName = FolderName & "\"
File = Dir(FolderName & Suffix)
Do While Len(File) > 0
UserForm2.ListBox1.AddItem File
nRow = nRow + 1: File = Dir
Loop
If Not SubDir Then Exit Sub
x = 0: Folder = Dir(FolderName, vbDirectory)
Do While Folder > ""
If Folder <> "." And Folder <> ".." Then
If (GetAttr(FolderName & Folder) And vbDirectory) = vbDirectory Then x = x + 1
End If
Folder = Dir
Loop
ReDim nbFolders(x + 1): i = 1
nbFolders(i) = Dir(FolderName, vbDirectory)
Do While nbFolders(i) > ""
If nbFolders(i) <> "." And nbFolders(i) <> ".." Then
If (GetAttr(FolderName & nbFolders(i)) And vbDirectory) = vbDirectory Then i = i + 1
End If
nbFolders(i) = Dir
Loop
For i = 1 To UBound(nbFolders()) - 1
Call Lister(nRow, FolderName & nbFolders(i), Suffix)
Next
Set objShell = Nothing
Set objFolder = Nothing
Set oFolderItem = Nothing
End Sub