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 · 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 & strFileSpec)
Do While strTemp <> vbNullString
    colFiles.Add strFolder & strTemp
    strTemp = Dir
Loop
If bIncludeSubfolders Then

    strTemp = Dir(strFolder, vbDirectory)
    Do While strTemp <> vbNullString
        If (strTemp <> ".") And (strTemp <> "..") Then
            If (GetAttr(strFolder & strTemp) And vbDirectory) <> 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 & vFolderName, strFileSpec, True)
    Next vFolderName
End If
End Function

Public Function TrailingSlash(strFolder As String) As String
If Len(strFolder) > 0 Then
    If Right(strFolder, 1) = "\" Then
        TrailingSlash = strFolder
    Else
        TrailingSlash = strFolder & "\"
    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

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

User · 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

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

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

Examples related to vba

Examples related to excel