VBA如何实现根据EXCEL单元格的关键字模糊匹配与自动复制文件?

在日常的办公环境中，我们经常需要处理大量的文件和文件夹，尤其是在进行项目管理、文档归档或数据整理时。传统的文件查找和复制过程往往耗时且容易出错，特别是在面对复杂的文件夹结构和模糊的文件名时。幸运的是，借助VBA（Visual Basic for Applications）这一强大的工具，我们可以自动化这一过程，大大提高工作效率和准确性。

本文将详细介绍如何使用VBA在Excel中编写一个自定义程序，该程序能够根据Excel工作表中指定的关键字，在指定的源文件夹及其子文件夹中模犊匹配文件名，并将匹配到的文件自动复制到目标文件夹中。这一功能特别适用于需要从大量文件中筛选出特定内容或格式文件的场景，如从项目文档库中查找包含特定关键词的报告、图片或其他文件类型。

具体实现上，我们将通过两个主要的VBA子程序来完成这项任务：一个是主程序根据单元格内容模糊匹配文件夹文件，用于初始化整个流程，并遍历Excel工作表中的每个关键字；另一个是递归函数CopyMatchingFiles，用于遍历源文件夹及其所有子文件夹，查找并复制匹配指定搜索模式的文件到目标文件夹（递归函数通常用于解决可以分解为更小相似问题的复杂问题，如：遍历树结构、计算阶乘、执行深度优先的搜索等）。代码如下：

Sub 根据单元格内容模糊匹配文件夹文件()
    Dim ws As Worksheet
    Dim cell As Range
    Dim fso As Object
    Dim lastRow,searchPattern As Long
    Dim sourceFolder As String
    Set ws = ThisWorkbook.Sheets("获取") ' 根据需求修改为你的工作表名称
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 案例关键字在A列
    sourceFolder = "C:\Users\dengjun\Desktop\SourceFolder\" ' 确保路径以反斜杠结束，可以根据自己需求做成选择窗体
    Dim targetFolder As String
    targetFolder = "C:\Users\dengjun\Desktop\TargetFolder\" ' 确保路径以反斜杠结束
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' 检查目标文件夹是否存在，如果不存在则创建
    If Not fso.FolderExists(targetFolder) Then
        fso.CreateFolder targetFolder
    End If
    ' 遍历工作表中的每个关键字
    For Each cell In ws.Range("A2:A" & lastRow) ' 假设A1是标题行
        searchPattern = "*" & cell.Value & "*"
        ' 调用递归函数来遍历文件夹和子文件夹
        CopyMatchingFiles sourceFolder, targetFolder, searchPattern
    Next cell   
    MsgBox "文件复制完成！"
End Sub

' 递归函数来遍历文件夹和子文件夹
Sub CopyMatchingFiles(ByVal sourceFolderPath As String, ByVal targetFolderPath As String, ByVal searchPattern As String)
    Dim folder As Object
    Dim subfolder As Object
    Dim file As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(sourceFolderPath)
    For Each file In folder.Files
        ' 使用Like操作符进行模糊匹配
        If file.Name Like searchPattern Then
            ' 复制文件
            fso.CopyFile file.Path, targetFolderPath & file.Name, True
        End If
    Next file
    For Each subfolder In folder.SubFolders
        ' 递归调用以遍历子文件夹
        CopyMatchingFiles subfolder.Path, targetFolderPath, searchPattern
    Next subfolder
End Sub

实现效果展示：

通过本文，你将学习到如何利用VBA处理文件系统操作，包括文件夹的遍历、文件的模糊匹配、文件的复制等，同时理解递归函数在解决这类问题中的重要作用。无论是对于Excel高级用户还是VBA初学者，本文都将是一个宝贵的资源，帮助你提升自动化办公的能力。