Excel VBA根据单元格值搜索到文件夹和子文件夹中获取文件路径和数据

Question

我们的系统生成并以 xlm 格式导出到“C:\Reports”中的每日报告，该报告按月和日组织为子文件夹，其中包括 A 列中的发票编号和 B 列中的序列号。

在日常工作中，我需要检查 30 个以上的序列号是否为它们生成了发票。 我做的是在一个新的工作簿中列出序列号在A列，然后一个一个复制粘贴到Windows资源管理器中在目录中搜索，如果有结果，我打开那个文件再搜索对于相同的序列号，将发票编号从 A 列复制到我的工作簿，然后为了参考，我将文件路径添加到 C 列，然后将其报告回来。

请帮助我。

我确信 Excel VBA 有一种方法可以使用 Windows 搜索并打开搜索和关闭文件，并获取文件路径。

Answer 1

这将在一张纸上创建所有日常文件的列表。

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("Path", "Workbook", "Invoice", "Serial No")
       
    ' 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)
        
        ' folder and file name
        ws.Cells(iRow, 1) = fso.getParentFolderName(myfile) ' path
        ws.Cells(iRow, 2) = fso.getFileName(myfile) ' no path
    
        ' 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, 3).Resize(r, 2) = rng.Value2
        wb.Close
        
        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