Excel VBA宏需求：遍历文件夹及子文件夹复制最新PDF文件

原代码存在两个核心问题：

• 仅遍历一级子文件夹，无法递归处理更深层级的子目录
• 复制文件时路径处理错误，且未实现「筛选创建时间最新的目标PDF」的需求

修复后的完整代码 #

Sub CopyLatestTargetPDF()
    Dim fso As Object
    Dim sourceFolder As Object
    Dim latestFile As Object
    Dim targetFileName As String
    
    ' 配置路径和目标文件名
    Const SourcePath As String = "C:\Users\OneDrive - Corporation\"
    Const DestinationPath As String = "Z:\Project\Task 17\"
    targetFileName = "R-001-002.PDF"
    
    ' 初始化文件系统对象
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 检查源文件夹是否存在
    If Not fso.FolderExists(SourcePath) Then
        MsgBox "源文件夹不存在！", vbExclamation
        Exit Sub
    End If
    
    ' 确保目标路径末尾有反斜杠
    Dim destPathWithSlash As String
    destPathWithSlash = IIf(Right(DestinationPath, 1) = "\", DestinationPath, DestinationPath & "\")
    
    ' 递归遍历所有子文件夹，找到最新的目标PDF
    Set sourceFolder = fso.GetFolder(SourcePath)
    Set latestFile = FindLatestPDF(sourceFolder, targetFileName, fso)
    
    ' 如果找到文件则复制
    If Not latestFile Is Nothing Then
        On Error Resume Next
        latestFile.Copy destPathWithSlash & latestFile.Name, OverwriteFiles:=True
        On Error GoTo 0
        
        If Err.Number = 0 Then
            MsgBox "已成功复制最新文件：" & latestFile.Path, vbInformation
        Else
            MsgBox "文件复制失败：" & Err.Description, vbCritical
        End If
    Else
        MsgBox "未找到目标文件 " & targetFileName, vbInformation
    End If
End Sub

' 递归遍历文件夹的辅助函数
Private Function FindLatestPDF(currentFolder As Object, targetName As String, fso As Object) As Object
    Dim file As Object
    Dim subFolder As Object
    Dim tempLatest As Object
    
    ' 检查当前文件夹中的文件
    For Each file In currentFolder.Files
        ' 匹配目标文件名（不区分大小写）
        If UCase(file.Name) = UCase(targetName) Then
            ' 对比创建时间，更新最新文件
            If tempLatest Is Nothing Or file.DateCreated > tempLatest.DateCreated Then
                Set tempLatest = file
            End If
        End If
    Next file
    
    ' 递归遍历子文件夹
    For Each subFolder In currentFolder.SubFolders
        Set tempLatest = FindLatestPDF(subFolder, targetName, fso)
    Next subFolder
    
    ' 返回找到的最新文件
    Set FindLatestPDF = tempLatest
End Function

关键修改说明 #

1. 递归遍历子文件夹：新增FindLatestPDF辅助函数，递归处理所有层级的子文件夹，确保不会遗漏深层目录中的文件
2. 筛选最新文件：通过对比DateCreated属性，记录创建时间最晚的目标PDF
3. 路径处理优化：
   • 确保目标路径末尾带有反斜杠，避免复制时路径拼接错误
   • 复制时指定OverwriteFiles:=True，允许覆盖目标路径中已存在的同名文件
4. 错误处理：添加文件夹存在检查和复制错误捕获，避免宏意外崩溃
5. 文件名匹配优化：使用UCase统一大小写，避免因文件名大小写不一致导致的匹配失败

内容的提问来源于stack exchange，提问作者Kishore K