The Reaper
New Member
- Joined
- Mar 21, 2012
- Messages
- 14
I got the info from NateO as far as the macro to search and report back with file paths, however what I cannot seem to do is the following:
I'm converting an old 2003 macro that used application.filesearch that would look in cell B4 for the file to look in, and cell J1 for the search criteria for example (these are input by a userform as they differ for each search):
B4: C:\Users\gabriel.vonwahl\Pictures
J1: *917*.jpg
So I need to figure out how to customize the below code to tell the macro to look in those cells for the values it needs to search, as I use this sheet for massive amounts of file path lookups to extract data etc. which the rest of my macros still work.
Old Code:
With Application.FileSearch
.LookIn = Range("B4")
.SearchSubFolders = True
.Filename = Range("J1")
.Execute
New Code to Customize:
Sub foobar()
Dim fso As Object
Dim strName As String
Dim strArr(1 To 65536, 1 To 1) As String, i As Long
Const strDir As String = "C:\Users\gabriel.vonwahl\Pictures"
Const searchTerm As String = "917"
Let strName = Dir$(strDir & "\*" & searchTerm & "*.jpg")
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, searchTerm)
Set fso = Nothing
If i > 0 Then
Range("A9").Resize(i).Value = strArr
End If
End Sub
Private Sub recurseSubFolders(ByRef Folder As Object, _
ByRef strArr() As String, _
ByRef i As Long, _
ByRef searchTerm As String)
Dim SubFolder As Object
Dim strName As String
For Each SubFolder In Folder.SubFolders
Let strName = Dir$(SubFolder.Path & "\*" & searchTerm & "*.jpg")
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i, 1) = SubFolder.Path & "\" & strName
Let strName = Dir$()
Loop
Call recurseSubFolders(SubFolder, strArr(), i, searchTerm)
Next
End Sub
I'm converting an old 2003 macro that used application.filesearch that would look in cell B4 for the file to look in, and cell J1 for the search criteria for example (these are input by a userform as they differ for each search):
B4: C:\Users\gabriel.vonwahl\Pictures
J1: *917*.jpg
So I need to figure out how to customize the below code to tell the macro to look in those cells for the values it needs to search, as I use this sheet for massive amounts of file path lookups to extract data etc. which the rest of my macros still work.
Old Code:
With Application.FileSearch
.LookIn = Range("B4")
.SearchSubFolders = True
.Filename = Range("J1")
.Execute
New Code to Customize:
Sub foobar()
Dim fso As Object
Dim strName As String
Dim strArr(1 To 65536, 1 To 1) As String, i As Long
Const strDir As String = "C:\Users\gabriel.vonwahl\Pictures"
Const searchTerm As String = "917"
Let strName = Dir$(strDir & "\*" & searchTerm & "*.jpg")
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, searchTerm)
Set fso = Nothing
If i > 0 Then
Range("A9").Resize(i).Value = strArr
End If
End Sub
Private Sub recurseSubFolders(ByRef Folder As Object, _
ByRef strArr() As String, _
ByRef i As Long, _
ByRef searchTerm As String)
Dim SubFolder As Object
Dim strName As String
For Each SubFolder In Folder.SubFolders
Let strName = Dir$(SubFolder.Path & "\*" & searchTerm & "*.jpg")
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i, 1) = SubFolder.Path & "\" & strName
Let strName = Dir$()
Loop
Call recurseSubFolders(SubFolder, strArr(), i, searchTerm)
Next
End Sub