Excel VBA search based on cell values into folders and sub-folders to get the file path and data

Question

Our system generates a daily report that is generated in xlm format to "C:Reports," which is divided into subfolders for the months and days and contains columns for the invoice number and the serial number.

I have to check more than 30 serial numbers every day to see if an invoice has been generated for them or not. I'm listing the serial numbers in a new workbook's column A, then copying and pasting each one into Windows Explorer one at a time to search the directory. If I find a match, I open that file, re-search for the same serial number, and copy the invoice number from column A to my worksheet.

Answer 1

This will create a listing of all the daily files on one sheet. You could use this with a VLookup from your list of invoices.

Option Explicit

Sub process_folder()

    Dim wb As Workbook, ws As Worksheet
    Set wb = ThisWorkbook
    
    ' results sheet
    Set ws = wb.Sheets(1)
    ws.UsedRange.Clear
    ws.Range("A1:D1") = Array("Serial No", "Invoice", "Path", "Workbook")
       
    ' create FSO Filesystem object
    Dim fso As Object, ts As Object, regEx As Object, txt As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'Opens the folder picker dialog to allow user selection
    Dim myfolder, myfile As String
    Dim parentfolder As String, oParent, rng As Range
    Dim iRow As Long, r As Long, n As Long
   
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\"
        .Title = "Please select the reports folder"
        .Show
        .AllowMultiSelect = False
        If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
            MsgBox "You did not select a folder"
            Exit Sub
        End If
        parentfolder = .SelectedItems(1) 'Assign selected folder to ParentFolder
    End With
    Set oParent = fso.getFolder(parentfolder)
    
    ' build collection of files
    Dim colFiles As Collection
    Set colFiles = New Collection
    Call GetFiles(oParent, "xlsm", colFiles)
    
    'Loop through all files in collection
    Application.ScreenUpdating = False
    iRow = 2
    For n = 1 To colFiles.Count
        myfile = colFiles(n)
    
        ' open file
        Set wb = Workbooks.Open(myfile, ReadOnly:=True)
        
        ' copy Column A and B
        Set rng = wb.Sheets(1).UsedRange.Resize(, 2)
        r = rng.Rows.Count
        ws.Cells(iRow, 1).Resize(r, 2) = rng.Value2
        wb.Close

        ' folder and file name
        ws.Cells(iRow, 3).resize(r) = fso.getParentFolderName(myfile) ' path
        ws.Cells(iRow, 4).resize(r) = fso.getFileName(myfile) ' no path
              
        iRow = iRow + r
        
    Next
    Application.ScreenUpdating = True
    MsgBox colFiles.Count & " Files process", vbInformation

End Sub

Sub GetFiles(oFolder, ext, ByRef colFiles)

    Dim f As Object
    For Each f In oFolder.Files
        If f.Name Like "*." & ext Then
            colFiles.Add oFolder.Path & "\" & f.Name
        End If
    Next
    
     ' call recursively fro subfolders
    For Each f In oFolder.subfolders
        Call GetFiles(f, ext, colFiles)
    Next
     
End Sub