VBA macro that search for file in multiple subfolders

Question

I have macro  if I put in cell E1 name of the file  macro search trough C  Users Marek Desktop Makro   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  Users Marek Desktop Makro   with many subfolders in it    My code   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  Users Marek Desktop Makro    amp  FName  amp    xls    Vystupna kontrola              A16 A17   Sheets  Sheet1   Range  B2 B3    True  False          GetData  C  Users Marek Desktop Makro    amp  FName  amp    xls    Vystupna kontrola              AE23 AE24   Sheets  Sheet1   Range  B3 B4    True  False          GetData  C  Users Marek Desktop Makro    amp  FName  amp    xls    Vystupna kontrola              AE26 AE27   Sheets  Sheet1   Range  B4 B5    True  False          GetData  C  Users Marek Desktop Makro    amp  FName  amp    xls    Vystupna kontrola              AQ59 AQ60   Sheets  Sheet1   Range  B5 B6    True  False          GetData  C  Users Marek Desktop Makro    amp  FName  amp    xls    Vystupna kontrola              AR65 AR66   Sheets  Sheet1   Range  B6 B7    True  False          End If    ChDrive SaveDriveDir   ChDir SaveDriveDir End Sub

User · Accepted Answer

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  amp    in    amp  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

User · Answer

I actually just found this today for something I m working on  This will return file paths for all files in a folder and its subfolders   Dim colFiles As New Collection RecursiveDir colFiles   C  Users Marek Desktop Makro           True Dim vFile As Variant  For Each vFile In colFiles       file operation here or store file name path in a string array for use later in the script      filepath n    vFile      filename   fso GetFileName vFile   If you want the filename without full path      n n 1 Next vFile    These two functions are required Public Function RecursiveDir colFiles As Collection  strFolder As String  strFileSpec As String  bIncludeSubfolders As Boolean  Dim strTemp As String Dim colFolders As New Collection Dim vFolderName As Variant strFolder   TrailingSlash strFolder  strTemp   Dir strFolder  amp  strFileSpec  Do While strTemp  lt  gt  vbNullString     colFiles Add strFolder  amp  strTemp     strTemp   Dir Loop If bIncludeSubfolders Then      strTemp   Dir strFolder  vbDirectory      Do While strTemp  lt  gt  vbNullString         If  strTemp  lt  gt       And  strTemp  lt  gt        Then             If  GetAttr strFolder  amp  strTemp  And vbDirectory   lt  gt  0 Then                 colFolders Add strTemp             End If         End If         strTemp   Dir     Loop      Call RecursiveDir for each subfolder in colFolders     For Each vFolderName In colFolders         Call RecursiveDir colFiles  strFolder  amp  vFolderName  strFileSpec  True      Next vFolderName End If End Function  Public Function TrailingSlash strFolder As String  As String If Len strFolder   gt  0 Then     If Right strFolder  1        Then         TrailingSlash   strFolder     Else         TrailingSlash   strFolder  amp          End If End If End Function   This is adapted from a post by Ammara Digital Image Solutions  http   www ammara com access image faq recursive folder search html

User · Answer

This sub will populate a Collection with all files matching the filename or pattern you pass in  Sub GetFiles StartFolder As String  Pattern As String                 DoSubfolders As Boolean  ByRef colFiles As Collection       Dim f As String  sf As String  subF As New Collection  s          If Right StartFolder  1   lt  gt   quot   quot  Then StartFolder   StartFolder  amp   quot   quot           f   Dir StartFolder  amp  Pattern      Do While Len f   gt  0         colFiles Add StartFolder  amp  f         f   Dir       Loop          If DoSubfolders then         sf   Dir StartFolder  vbDirectory          Do While Len sf   gt  0             If sf  lt  gt   quot   quot  And sf  lt  gt   quot    quot  Then                 If  GetAttr StartFolder  amp  sf  And vbDirectory   lt  gt  0 Then                         subF Add StartFolder  amp  sf                 End If             End If             sf   Dir           Loop              For Each s In subF             GetFiles CStr s   Pattern  True  colFiles         Next s     End If  End Sub  Usage  Dim colFiles As New Collection  GetFiles  quot C  Users Marek Desktop Makro  quot   FName  amp   quot  xls quot   True  colFiles If colFiles Count  gt  0 Then      work with found files End If

User · Answer

If this helps  you can also use FileSystemObject to retrieve all subfolders of a folder  You need to check the reference  Microsot Scripting Runtime  to get Intellisense and use the  new  keyword   Sub GetSubFolders        Dim fso As New FileSystemObject     Dim f As Folder  sf As Folder      Set f   fso GetFolder  D  Proj        For Each sf In f SubFolders          Code inside     Next  End Sub

[vba] VBA macro that search for file in multiple subfolders

Examples related to vba

Examples related to excel