Dim FSO As Object
Dim StartFldr As Object
Dim StartPth As String
Dim Lst As Variant
Private Sub CheckBox1_Click()
Me.FileList.Clear
Call RecursiveFolder(FSO, StartFldr, Me.CheckBox1.Value)
End Sub
Private Sub UserForm_Initialize()
StartPth = "C:\mrexcel\"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set StartFldr = FSO.getFolder(StartPth)
Call RecursiveFolder(FSO, StartFldr, False)
Me.FileList.ColumnWidths = "0;200"
End Sub
Sub RecursiveFolder(FSO As Object, Fldr As Object, IncludeSubFolders As Boolean)
Dim FldrFile As Object, SubFldr As Object
Debug.Print Fldr.Name
For Each FldrFile In Fldr.Files
If FSO.GetExtensionName(FldrFile) Like "xls*" Then
With Me.FileList
.AddItem FldrFile
.List(.ListCount - 1, 1) = FldrFile.Name
End With
End If
Next FldrFile
If IncludeSubFolders Then
For Each SubFldr In Fldr.subfolders
Call RecursiveFolder(FSO, SubFldr, True)
Next SubFldr
End If
Lst = Me.FileList.List
End Sub
Private Sub OK_Click()
Workbooks.Open FileList.Value
End Sub
Private Sub searchbox_Change()
Dim NLst As Variant
Dim i As Long, r As Long
Static Srch As String
If Len(Me.searchbox.Value) < Srch Then
Me.FileList.List = Lst
End If
Lst = Me.FileList.List
Srch = Me.searchbox.Value
ReDim NLst(1 To UBound(Lst), 1 To 2)
For i = 1 To UBound(Lst)
If InStr(1, Lst(i, 1), Srch, 1) > 0 Then
r = r + 1: NLst(r, 1) = Lst(i, 0): NLst(r, 2) = Lst(i, 1)
End If
Next i
Me.FileList.List = NLst
End Sub