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

Question

Our system is generate and a daily report which is exported in xlm format in "C:\Reports", which is organized in months and days as a subfolders, that include Invoice number in column A and serial number in column B.

In a daily bases, I need to check more that 30 serial numbers if there is an invoice generated for them or not. What I am doing is to list the serial numbers in a new workbook in A column, then one-by-one copy and paste it in Windows Explorer to search in the directory, if I got a result, I open that file and again search for the same serial number and copy the invoice number from column A to my workbook, then for referance, I add the file path to column C then report it back.

Kindly help me.

I am sure that there is a way from Excel VBA to work with Windows search and open search and close files, and get the file path.

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