请求修改VBA文件复制代码：增加文件扩展名匹配校验功能

以下是修改后的代码，实现读取Excel表格A列文件名、B列对应扩展名，仅当文件实际扩展名与B列匹配时才执行复制：

Sub CopyFilesByMatchingNameAndExt()
    Const sPath As String = "E:\Uploading\Source"
    Const dPath As String = "E:\Uploading\Destination\Destination_2\!Destination_3"
    Const fRow As Long = 2 ' 数据起始行
    
    ' 引用工作表
    Dim ws As Worksheet: Set ws = Sheet2
    ' 计算数据最后一行（以A列为准，确保文件名非空）
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                
    ' 验证数据行
    If lRow < fRow Then
        MsgBox "A列无有效数据。", vbCritical
        Exit Sub
    End If
    
    ' 绑定FileSystemObject（Early Binding，需添加引用：Tools > References > Microsoft Scripting Runtime）
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject
    ' 若使用Late Binding，取消注释下面两行并注释上面两行
    'Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 验证源文件夹路径
    Dim sFolderPath As String: sFolderPath = sPath
    If Right(sFolderPath, 1) <> "\" Then sFolderPath = sFolderPath & "\"
    If Not fso.FolderExists(sFolderPath) Then
        MsgBox "源文件夹路径 '" & sFolderPath & "' 不存在。", vbCritical
        Exit Sub
    End If
    
    ' 验证目标文件夹路径
    Dim dFolderPath As String: dFolderPath = dPath
    If Right(dFolderPath, 1) <> "\" Then dFolderPath = dFolderPath & "\"
    If Not fso.FolderExists(dFolderPath) Then
        MsgBox "目标文件夹路径 '" & dFolderPath & "' 不存在。", vbCritical
        Exit Sub
    End If
    
    Dim r As Long ' 当前行号
    Dim sFileNamePrefix As String ' A列的文件名前缀
    Dim targetExt As String ' B列的目标扩展名
    Dim sFileName As String ' 找到的源文件名
    Dim sFilePath As String ' 源文件完整路径
    Dim dFilePath As String ' 目标文件完整路径
    Dim actualExt As String ' 文件实际扩展名
    
    ' 统计变量
    Dim copiedCount As Long ' 成功复制的文件数
    Dim existsInDestCount As Long ' 目标已存在的文件数
    Dim notFoundCount As Long ' 未找到的文件数
    Dim blankRowCount As Long ' 空行计数
    Dim extMismatchCount As Long ' 扩展名不匹配的文件数
    
    For r = fRow To lRow
        sFileNamePrefix = Trim(CStr(ws.Cells(r, "A").Value))
        targetExt = UCase(Trim(CStr(ws.Cells(r, "B").Value)))
        
        ' 跳过A列或B列空的行
        If Len(sFileNamePrefix) = 0 Or Len(targetExt) = 0 Then
            blankRowCount = blankRowCount + 1
            GoTo NextRow
        End If
        
        ' 查找源文件夹中以指定前缀开头的文件（若需要包含前缀，改为 "*" & sFileNamePrefix & "*"）
        sFileName = Dir(sFolderPath & sFileNamePrefix & "*")
        
        Do While sFileName <> ""
            ' 获取文件实际扩展名（转大写）
            actualExt = UCase(fso.GetExtensionName(sFileName))
            
            ' 验证扩展名是否匹配
            If actualExt = targetExt Then
                sFilePath = sFolderPath & sFileName
                dFilePath = dFolderPath & sFileName
                
                ' 检查目标文件夹是否已存在该文件
                If Not fso.FileExists(dFilePath) Then
                    fso.CopyFile sFilePath, dFilePath
                    copiedCount = copiedCount + 1
                Else
                    existsInDestCount = existsInDestCount + 1
                End If
            Else
                extMismatchCount = extMismatchCount + 1
            End If
            
            ' 查找下一个文件
            sFileName = Dir
        Loop
        
        ' 若未找到任何匹配前缀的文件，增加未找到计数
        If sFileName = "" And Dir(sFolderPath & sFileNamePrefix & "*") = "" Then
            notFoundCount = notFoundCount + 1
        End If
        
NextRow:
    Next r
    
    ' 显示执行结果统计
    MsgBox "执行完成：" & vbCrLf _
        & "成功复制文件：" & copiedCount & vbCrLf _
        & "目标已存在文件：" & existsInDestCount & vbCrLf _
        & "扩展名不匹配跳过：" & extMismatchCount & vbCrLf _
        & "未找到匹配前缀的文件：" & notFoundCount & vbCrLf _
        & "空行/无效行：" & blankRowCount, vbInformation
End Sub

关键修改说明 #

• 数据源适配：改为读取A列文件名前缀、B列目标扩展名，跳过任意一列空的行
• 扩展名匹配：使用fso.GetExtensionName获取文件实际扩展名，统一转大写后对比，避免大小写差异导致的匹配失败
• 统计增强：新增扩展名不匹配的计数，同时保留原有的复制成功、目标已存在、未找到文件、空行统计，并在执行结束后弹窗展示
• 路径逻辑优化：以A列为基准计算数据最后一行，确保只处理有文件名的行

内容的提问来源于stack exchange，提问作者Salman Shafi