The method 'Filesearch' has been removed from VBA since office 2007.
If you only need to make an inventory in 1 folder you can use the VBA method 'dir' (see Ia) or the method 'files' from the 'scripting.filesystemobject'-library (see Ib).
If you want to include subfolders you can use the method 'dir' from the 'Shell' library. (IIa and IIb)
If you use this method VBA can only write the result to an ASCII-file. You can get this information by opening this file as an Excelfile (IIa) or read it as a 'freefile' (IIb).
In these 4 examples the method to open a file fom the inventory is Getobject(filename); that's fast because it's completely hidden and it's multipurpose (opening Word, Excel, Access, etc. files)
If you are dealing with Excelfiles you can also use workbooks.open (see IIIa) or workbooks.add (see IIIb)
Ia
Sub alt_filesearch_no_subfolder_001()
c00 = "E:\OF\" ' change the foldername if necessary ; always ending with \
c01 = Dir(c00 & "*.xls") ' change the extension if necessary
Do Until c01 = ""
With GetObject(c00 & c01)
' change something
.Close True
End With
c01 = Dir
Loop
End Sub
Ib
Sub alt_filesearch_no_subfolder_002()
c00 = "E:\OF" ' change the foldername if necessary
c01 = "xls" ' change the extension if necessary
With CreateObject("scripting.filesystemobject")
For Each fl In .getfolder(c00).Files
If .getextensionname(fl) = c01 Then
With GetObject(fl)
' do something
.Close True
End With
End If
Next
End With
End Sub
IIa
Sub alt_filesearch_including_subfolders_001()
c00 = "E:\files.txt" ' change the filename to which the result will be written if necessary
Application.DisplayAlerts = False
If Dir(c00) <> "" Then Kill c00
Shell Environ("comspec") & " /c Dir C:\*.xls /s /b > " & c00
Do
DoEvents
Loop Until Dir(c00) <> ""
Do
DoEvents
Loop Until FileLen(c00) > 0
With Workbooks.Add(c00)
sn = .Sheets(1).Columns(1).SpecialCells(2)
.Close False
End With
For j = 1 To UBound(sn)
With GetObject(sn(j, 1))
' do something
.Close True
End With
Next
End Sub
IIb
Sub alt_filesearch_including_subfolders_002()
c00 = "E:\files.txt"
Application.DisplayAlerts = False
If Dir(c00) <> "" Then Kill c00
Shell Environ("comspec") & " /c Dir C:\*.xls /s /b > " & c00
Do
DoEvents
Loop Until Dir(c00) <> ""
Do
DoEvents
Loop Until FileLen(c00) > 0
Open c00 For Input As #1
sn = Split(Input(LOF(1), #1), vbCrLf)
Close #1
For j = 0 To UBound(sn)
With GetObject(sn(j))
.Sheets(1).Cells(1, 100) = "check"
' do something
.Close True
End With
Next
End Sub
IIIa
For j = 0 To UBound(sn)
With Workbook.open(sn(j))
' do something
.Close True
End With
Next
IIIb
For j = 0 To UBound(sn)
With Workbook.Add(sn(j))
' do something
.SaveAs sn(j)
.Close false
End With
Next
Bookmarks