VBA操作多个文件夹文件汇总

CSV文件汇总工具.xlsm

功能实现思路

1. 用户界面：工作表放置按钮和路径显示区域
2. 文件夹选择：分别选择A/B/C等源文件夹和目标文件夹
3. 文件复制逻辑：
   • 仅复制根目录下的CSV文件（跳过子文件夹）
   • 跳过.xlsm等其他格式文件
   • 同名文件比较修改时间，保留最新版本
   • 相同修改时间则跳过复制
   • 记录变化的文件数量

Option Explicit

' 检查单个路径是否有效的函数
Function CheckSinglePath(ByVal path As String, ByVal pathType As String) As Boolean
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    If fso.FolderExists(path) Then
        CheckSinglePath = True
    Else
        MsgBox pathType & "路径不存在: " & path, vbExclamation
        CheckSinglePath = False
    End If
    
    Set fso = Nothing
End Function

' 处理单个源路径的函数
Sub ProcessSourcePath(ByVal sourcePath As String, ByVal targetPath As String, _
                      ByRef csvCount As Long, ByRef copiedCount As Long, ByRef newerInTargetCount As Long)
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim newFilePath As String
    Dim sourceModDate As Date
    Dim targetModDate As Date
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(sourcePath)
    
    csvCount = 0
    copiedCount = 0
    newerInTargetCount = 0
    
    ' 遍历文件夹中的文件
    For Each file In folder.Files
        ' 只处理 CSV 文件
        If UCase(fso.GetExtensionName(file.Name)) = "CSV" Then
            csvCount = csvCount + 1
            newFilePath = fso.BuildPath(targetPath, file.Name)
            sourceModDate = file.DateLastModified
            
            ' 检查目标文件夹中是否已有同名文件
            If fso.FileExists(newFilePath) Then
                targetModDate = fso.GetFile(newFilePath).DateLastModified
                ' 比较修改时间
                If sourceModDate > targetModDate Then
                    file.Copy newFilePath, True ' 覆盖旧文件
                    copiedCount = copiedCount + 1
                Else
                    newerInTargetCount = newerInTargetCount + 1
                End If
            Else
                ' 直接复制新文件
                file.Copy newFilePath
                copiedCount = copiedCount + 1
            End If
        End If
    Next file
    
    Set fso = Nothing
End Sub

' 主控 Sub 函数
Sub CopyCSVFiles()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim sourcePath As String
    Dim targetPath As String
    Dim csvCount As Long
    Dim copiedCount As Long
    Dim newerInTargetCount As Long
    Dim fso As Object
    
    ' 设置工作表
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 查找最后一个非空行
    lastRow = ws.Range("No").Cells(ws.Range("No").Rows.Count, 1).End(xlUp).Row - 2
    
    ' 检查所有路径
    For i = 3 To lastRow + 2
        sourcePath = ws.Range("Sour_Path").Cells(i - 2, 1).Value
        targetPath = ws.Range("Tar_Path").Cells(i - 2, 1).Value
        
        ' 检查源路径
        If Not CheckSinglePath(sourcePath, "源") Then
            Exit Sub
        End If
        
        ' 检查目标路径，若不存在则尝试创建
        If Not fso.FolderExists(targetPath) Then
            On Error Resume Next
            fso.CreateFolder targetPath
            If Err.Number <> 0 Then
                MsgBox "无法创建目标路径: " & targetPath, vbExclamation
                Exit Sub
            End If
            On Error GoTo 0
        End If
    Next i
    
    ' 处理每个源路径
    For i = 3 To lastRow + 2
        sourcePath = ws.Range("Sour_Path").Cells(i - 2, 1).Value
        targetPath = ws.Range("Tar_Path").Cells(i - 2, 1).Value
        
        ' 处理源路径
        Call ProcessSourcePath(sourcePath, targetPath, csvCount, copiedCount, newerInTargetCount)
        
        ' 输出统计结果
        ws.Range("D" & i).Value = csvCount
        ws.Range("E" & i).Value = copiedCount
        ws.Range("F" & i).Value = newerInTargetCount
    Next i
    
    MsgBox "CSV 文件复制和统计完成！", vbInformation
    Set fso = Nothing
    Set ws = Nothing
End Sub

优化与说明：

1. CheckSinglePath 函数：

   • 输入参数：path（路径字符串）和 pathType（用于提示的路径类型，如“源”或“目标”）。
   • 功能：检查单个路径是否存在，返回布尔值（True 表示存在，False 表示不存在并弹出提示）。
   • 通用性：可单独调用，适用于任何路径检查场景，增强了模块化设计。

2. ProcessSourcePath 函数：

   • 负责处理单个源路径的 CSV 文件复制逻辑。
   • 忽略子文件夹和非 CSV 文件，处理同名文件的修改时间比较，统计 CSV 文件总数、复制数量和目标路径中更新的文件数量。

3. CopyCSVFiles 主函数：

   • 路径检查：逐行检查源路径和目标路径，使用 CheckSinglePath 函数。若源路径无效，程序终止；若目标路径不存在，尝试创建，创建失败则终止。
   • 路径处理：对每行调用 ProcessSourcePath，并将统计结果写入 D、E、F 列。
   • 通用性增强：通过分离路径检查逻辑，代码更模块化，易于复用和维护。

4. 工作表结构：

   • A2: “数量”，A3:A7 为序号 1-5。
   • B2: “源路径”，B3:B7 为源文件夹路径。
   • C2: “目标路径”，C3:C7 为目标文件夹路径。
   • D2: “源路径所有csv数量”，D3:D7 输出 CSV 文件总数。
   • E2: “拷贝的文件数量”，E3:E7 输出复制的文件数量。
   • F2: “目标路径中更晚的文件数量”，F3:F7 输出目标路径中修改时间相同或更晚的文件数量。

5. 使用步骤：

   • 在 Sheet1 中设置操作面板，填入源路径和目标路径（例如 C:\Data\A\、C:\Data\Summary\）。
   • 打开 VBA 编辑器（Alt + F11），插入模块，粘贴代码。
   • 运行 CopyCSVFiles 宏。
   • 确保路径格式正确（以 \ 结尾），且有读写权限。

6. 特点：

   • 通用性：CheckSinglePath 函数可独立用于任何路径检查场景，适合扩展到其他项目。
   • 错误处理：路径检查更细化，源路径和目标路径分别验证，提示信息更清晰。
   • 模块化：代码结构清晰，易于维护和添加新功能。

7. 注意事项：

   • 确保 Sheet1 中命名区域（“No”、“Sour_Path”、“Tar_Path”）正确设置。
   • 路径需以反斜杠 \ 结尾，避免拼接错误。