Public FolderList As Variant
Public FileList As Variant 'setting this as global so it stays loaded.
Private Sub UserForm_Initialize()
On Error Resume Next
ReDim FileList(1 To 2, 1 To 1) As String 'reinitialize FileList
Dim i As Long, n As Long, j As Long
Dim x As Variant 'not sure what this was for
Dim fName As String, fldrName As String, FilePath As String
FilePath = "C:\Users\Russel\Documents\Projects\"
ReDim FolderList(1 To 1) As String 'reinitialize FolderList
FolderList(1) = FilePath
listDir FilePath, 1 'loads array FolderList with folders/subfolders
i = 1
For j = 1 To UBound(FolderList)
fName = Dir(FolderList(j) & "*" & SearchBox.Value & "*.xls*")
Do While fName <> ""
ReDim Preserve FileList(1 To 2, 1 To i) As String
FileList(1, i) = FolderList(j) & fName
FileList(2, i) = fName
i = i + 1
fName = Dir()
Loop
Next j
'ReDim Preserve FileList(1 To i - 1) ***this shouldn't be necessary
With Me.ListBox1
.BoundColumn = 1
.ColumnCount = 2
.ColumnWidths = "0 pt; " & .Width & " pt"
.Clear
.Column = FileList
End With
End Sub
Public Sub listDir(strPath As String, lngSheet As Long)
Dim strFn As String
Dim strDirList() As String
Dim lngArrayMax, x As Long
lngArrayMax = 0
strFn = Dir(strPath & "*.*", 23)
While strFn <> ""
If strFn <> "." And strFn <> ".." Then
If (GetAttr(strPath & strFn) And vbDirectory) = vbDirectory Then
If IsEmpty(FolderList) Then
ReDim FolderList(1 To 1) As String
Else
ReDim Preserve FolderList(1 To UBound(FolderList) + 1) As String
End If
FolderList(UBound(FolderList)) = strPath & strFn & "\"
lngArrayMax = lngArrayMax + 1
ReDim Preserve strDirList(lngArrayMax)
strDirList(lngArrayMax) = strPath & strFn & "\"
End If
End If
strFn = Dir()
Wend
If lngArrayMax <> 0 Then
For x = 1 To lngArrayMax
Call listDir(strDirList(x), lngSheet)
Next
End If
End Sub
Private Sub Listbox1_Click()
'On Error Resume Next
Dim i As Long, wb As Workbook
With Me.ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
Set wb = Workbooks.Open(.List(i), UpdateLinks:=0)
wb.Activate
Unload SearchForm
Exit For
End If
Next
End With
End Sub
Private Sub SearchBox_Change()
Dim filteredFileList As Variant
For i = 1 To UBound(FileList, 2)
'If FileList(2, i) Like "*" & SearchBox.Value & "*" Then 'Use this instead of the following row if you want CASE-SENSITIVE lookup
If UCase(FileList(2,i) Like "*" & UCase(SearchBox.Value) & "*" Then 'Use this row for CASE-INSENSITIVE lookup
If IsEmpty(filteredFileList) Then
ReDim filteredFileList(1 To 2, 1 To 1) As String
Else
ReDim Preserve filteredFileList(1 To 2, 1 To UBound(filteredFileList, 2) + 1) As String
End If
filteredFileList(1, UBound(filteredFileList, 2)) = FileList(1, i)
filteredFileList(2, UBound(filteredFileList, 2)) = FileList(2, i)
End If
Next i
If IsEmpty(filteredFileList) Then
Me.ListBox1.Clear
Else
With Me.ListBox1
.BoundColumn = 1
.ColumnCount = 2
.ColumnWidths = "0 pt; " & .Width & " pt"
.Clear
.Column = filteredFileList
End With
End If
End Sub
