Question posted 2013 · +2 upvotes
I have macro, if I put in cell E1 name of the file, macro search trough C:UsersMarekDesktopMakro directory, find it and put the needed values in specific cells of my original file with macro.
Is it possible to make this work without specific folder location? I need something that can search trough C:UsersMarekDesktopMakro with many subfolders in it.
My code is
Sub Zila1()
Dim SaveDriveDir As String, MyPath As String
Dim FName As Variant
Dim YrMth As String
SaveDriveDir = CurDir
MyPath = Application.DefaultFilePath 'or use "C:Data"
ChDrive MyPath
ChDir MyPath
FName = Sheets("Sheet1").Range("E1").Text
If FName = False Then
'do nothing
Else
GetData "C:UsersMarekDesktopMakro" & FName & ".xls", "Vystupna_kontrola", _
"A16:A17", Sheets("Sheet1").Range("B2:B3"), True, False
GetData "C:UsersMarekDesktopMakro" & FName & ".xls", "Vystupna_kontrola", _
"AE23:AE24", Sheets("Sheet1").Range("B3:B4"), True, False
GetData "C:UsersMarekDesktopMakro" & FName & ".xls", "Vystupna_kontrola", _
"AE26:AE27", Sheets("Sheet1").Range("B4:B5"), True, False
GetData "C:UsersMarekDesktopMakro" & FName & ".xls", "Vystupna_kontrola", _
"AQ59:AQ60", Sheets("Sheet1").Range("B5:B6"), True, False
GetData "C:UsersMarekDesktopMakro" & FName & ".xls", "Vystupna_kontrola", _
"AR65:AR66", Sheets("Sheet1").Range("B6:B7"), True, False
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
End Sub
Accepted answer +12 upvotes
Just for fun, here’s a sample with a recursive function which (I hope) should be a bit simpler to understand and to use with your code:
Function Recurse(sPath As String) As String
Dim FSO As New FileSystemObject
Dim myFolder As Folder
Dim mySubFolder As Folder
Set myFolder = FSO.GetFolder(sPath)
For Each mySubFolder In myFolder.SubFolders
Call TestSub(mySubFolder.Path)
Recurse = Recurse(mySubFolder.Path)
Next
End Function
Sub TestR()
Call Recurse("D:Projets")
End Sub
Sub TestSub(ByVal s As String)
Debug.Print s
End Sub
Edit: Here’s how you can implement this code in your workbook to achieve your objective.
Sub TestSub(ByVal s As String)
Dim FSO As New FileSystemObject
Dim myFolder As Folder
Dim myFile As File
Set myFolder = FSO.GetFolder(s)
For Each myFile In myFolder.Files
If myFile.Name = Range("E1").Value Then
Debug.Print myFile.Name 'Or do whatever you want with the file
End If
Next
End Sub
Here, I just debug the name of the found file, the rest is up to you. 😉
Of course, some would say it’s a bit clumsy to call twice the FileSystemObject so you could simply write your code like this (depends on wether you want to compartmentalize or not):
Function Recurse(sPath As String) As String
Dim FSO As New FileSystemObject
Dim myFolder As Folder
Dim mySubFolder As Folder
Dim myFile As File
Set myFolder = FSO.GetFolder(sPath)
For Each mySubFolder In myFolder.SubFolders
For Each myFile In mySubFolder.Files
If myFile.Name = Range("E1").Value Then
Debug.Print myFile.Name & " in " & myFile.Path 'Or do whatever you want with the file
Exit For
End If
Next
Recurse = Recurse(mySubFolder.Path)
Next
End Function
Sub TestR()
Call Recurse("D:Projets")
End Sub
3 code variants in this answer
- Variant 1 — 25 lines, starts with
Function Recurse(sPath As String) As String - Variant 2 — 14 lines, starts with
Sub TestSub(ByVal s As String) - Variant 3 — 26 lines, starts with
Function Recurse(sPath As String) As String
Excel VBA objects referenced (4)
Application— Using events with the Application objectApplication— Working with Other ApplicationsRange— Refer to Cells by Using a Range ObjectRange— Delete Duplicate Entries in a Range
Top excel-vba Q&A (6)
- How to clear the entire array? +58 (2010)
- How to change Format of a Cell to Text using VBA +55 (2011)
- Download attachment from Outlook and Open in Excel +43 (2012)
- Can a VBA function in Excel return a range? +36 (2009)
- 2 Dimensional array from range +34 (2013)
- Hiding an Excel worksheet with VBA +33 (2009)
excel-vba solutions on this site
.