There are at least 4 methods that I use for that sort of thing. Dir() is an easy one if you don't need to iterate subfolders.
e.g.
Sub DirFiles()
Dim FileName As String, FileSpec As String, FileFolder As String
Dim wb As Workbook
FileFolder = ThisWorkbook.Path & "\"
FileSpec = FileFolder & "*.xlsm"
FileName = Dir(FileSpec)
If FileName = "" Then Exit Sub
' Loop until no more matching files are found
Do While FileName <> ""
If IsWorkbookOpen(FileName) = False Then
'Set wb = Workbooks.Open(FileFolder & FileName)
'DoEvents
'wb.Close True
Debug.Print FileName
End If
FileName = Dir()
Loop
End Sub
Function IsWorkbookOpen(stName As String) As Boolean
Dim Wkb As Workbook
On Error Resume Next ' In Case it isn't Open
Set Wkb = Workbooks(stName)
If Not Wkb Is Nothing Then IsWorkbookOpen = True
'Boolean Function assumed To be False unless Set To True
End Function
Similarly:
'http://spreadsheetpage.com/index.php/tip/getting_a_list_of_file_names_using_vba/
Sub Test_GetFileList()
Dim p As String, x As Variant, i As Integer
p = ThisWorkbook.Path & "/*.xls"
x = GetFileList(p)
Select Case IsArray(x)
Case True 'files found
MsgBox UBound(x), , "Count of Found Files"
Sheets("Sheet1").Range("A:A").Clear
For i = LBound(x) To UBound(x)
Sheets("Sheet1").Cells(i, 1).Value = x(i)
Next i
Case False 'no files found
MsgBox "No matching files"
End Select
End Sub
Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
On Error GoTo NoFilesFound
FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound
' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function
' Error handler
NoFilesFound:
GetFileList = False
End Function
For the more robust FSO method:
'http://www.ozgrid.com/forum/showthread.php?t=157939
Sub Test_SearchFiles()
Dim v As Variant, a() As Variant
SearchFiles ThisWorkbook.Path, "*.xls", 0, a(), True
For Each v In a()
Debug.Print v
Next v
End Sub
Private Function SearchFiles(myDir As String _
, myFileName As String, n As Long, myList() _
, Optional SearchSub As Boolean = False) As Variant
Dim fso As Object, myFolder As Object, myFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
For Each myFile In fso.getfolder(myDir).Files
Select Case myFile.Attributes
Case 2, 4, 6, 34
Case Else
If (Not myFile.Name Like "~$*") _
* (myFile.Path & "\" & myFile.Name <> ThisWorkbook.FullName) _
* (UCase(myFile.Name) Like UCase(myFileName)) Then
n = n + 1
ReDim Preserve myList(1 To 2, 1 To n)
myList(1, n) = myDir
myList(2, n) = myFile.Name
End If
End Select
Next
If SearchSub Then
For Each myFolder In fso.getfolder(myDir).subfolders
SearchFiles = SearchFiles(myFolder.Path, myFileName, _
n, myList, SearchSub)
Next
End If
SearchFiles = IIf(n > 0, myList, CVErr(xlErrRef))
End Function
The 3rd method would use a Class and it would be used similar to the FileSearch method. Most find the two methods above sufficient. The advantage to the 3rd method is that you don't have to change alot of code built already. If this interests you see:
'ginismo, http://www.mrexcel.com/forum/showthread.php?t=369982 'Class method
'http://www.mrexcel.com/forum/showthread.php?p=1839452
'http://www.4shared.com/file/87591234/8d1d705d/1839452_classFileSearch_and_Excel4.html
'http://www.mrexcel.com/forum/showthread.php?p=2551004 'alternate class method
'http://dl.dropbox.com/u/35239054/FileSearch.cls 'alternate class method by Andreas Killer, version 1.43
Reply With Quote
