Hi,
I modifed the file listing macro on p. 119 of the VBA and Macros: Microsoft Excel 2010 book to list all Excel files instead of jpg files. I changed the folder name to the name of one of my network folders and I changed the file type wild card to *.xl* to pick up all Excel files.
The macro returns a list of all of the files in the main folder, but doesn't list the files in subfolders. Hopefully someone can show me where I'm going wrong, my code is below.
Thanks for the help!
David
Sub FindExcelFilesInAFolder()
' New method for Excel 2007/2010
' You need this macro, plus the following macro
' Page 119-120
Dim fso As Object
Dim strName As String
Dim strArr(1 To 1048576, 1 To 1) As String, i As Long
' Enter the folder name here
Const strDir As String = "T:\finance1\2012\2012 Month End Close\03 March\"
Let strName = Dir$(strDir & "*.xls*")
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i, 1) = strDir & strName
Let strName = Dir$()
Loop
Set fso = CreateObject("Scripting.FileSystemObject")
Call recurseSubFolders(fso.GetFolder(strDir), strArr(), i)
Set fso = Nothing
If i > 0 Then
Range("A1").Resize(i).Value = strArr
End If
' Next, loop through all found files
' and break into path and filename
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To FinalRow
ThisEntry = Cells(i, 1)
For j = Len(ThisEntry) To 1 Step -1
If Mid(ThisEntry, j, 1) = Application.PathSeparator Then
Cells(i, 2) = Left(ThisEntry, j)
Cells(i, 3) = Mid(ThisEntry, j + 1)
Exit For
End If
Next j
Next i
End Sub
Private Sub recurseSubFolders(ByRef Folder As Object, _
ByRef strArr() As String, _
ByRef i As Long)
Dim SubFolder As Object
Dim strName As String
For Each SubFolder In Folder.SubFolders
Let strName = Dir$(SubFolder.Path & "*.xls*")
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i, 1) = SubFolder.Path & strName
Let strName = Dir$()
Loop
Call recurseSubFolders(SubFolder, strArr(), i)
Next
End Sub
I modifed the file listing macro on p. 119 of the VBA and Macros: Microsoft Excel 2010 book to list all Excel files instead of jpg files. I changed the folder name to the name of one of my network folders and I changed the file type wild card to *.xl* to pick up all Excel files.
The macro returns a list of all of the files in the main folder, but doesn't list the files in subfolders. Hopefully someone can show me where I'm going wrong, my code is below.
Thanks for the help!
David
Sub FindExcelFilesInAFolder()
' New method for Excel 2007/2010
' You need this macro, plus the following macro
' Page 119-120
Dim fso As Object
Dim strName As String
Dim strArr(1 To 1048576, 1 To 1) As String, i As Long
' Enter the folder name here
Const strDir As String = "T:\finance1\2012\2012 Month End Close\03 March\"
Let strName = Dir$(strDir & "*.xls*")
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i, 1) = strDir & strName
Let strName = Dir$()
Loop
Set fso = CreateObject("Scripting.FileSystemObject")
Call recurseSubFolders(fso.GetFolder(strDir), strArr(), i)
Set fso = Nothing
If i > 0 Then
Range("A1").Resize(i).Value = strArr
End If
' Next, loop through all found files
' and break into path and filename
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To FinalRow
ThisEntry = Cells(i, 1)
For j = Len(ThisEntry) To 1 Step -1
If Mid(ThisEntry, j, 1) = Application.PathSeparator Then
Cells(i, 2) = Left(ThisEntry, j)
Cells(i, 3) = Mid(ThisEntry, j + 1)
Exit For
End If
Next j
Next i
End Sub
Private Sub recurseSubFolders(ByRef Folder As Object, _
ByRef strArr() As String, _
ByRef i As Long)
Dim SubFolder As Object
Dim strName As String
For Each SubFolder In Folder.SubFolders
Let strName = Dir$(SubFolder.Path & "*.xls*")
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i, 1) = SubFolder.Path & strName
Let strName = Dir$()
Loop
Call recurseSubFolders(SubFolder, strArr(), i)
Next
End Sub