如何通过Excel VBA按表格指定路径批量复制图片至目标文件夹？

原固定路径代码失效的常见原因 #

• 源文件不存在或路径输入错误
• 目标路径的上级文件夹未创建（FileCopy无法自动生成文件夹）
• 文件夹/文件被锁定、无读写权限

可行的批量处理VBA代码 #

下面的代码会读取Excel表格中A列的源文件路径、B列的目标路径，逐行完成复制，同时加入错误处理和文件夹自动创建逻辑：

Sub BatchFileCopy()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim sourcePath As String
    Dim destPath As String
    Dim destFolder As String
    
    ' 设置要读取的工作表，这里用当前激活的工作表，可改成Sheet1之类的
    Set ws = ActiveSheet
    ' 获取数据的最后一行（假设A列有连续路径）
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 从第2行开始循环（第1行是表头的话）
    For i = 2 To lastRow
        sourcePath = Trim(ws.Cells(i, "A").Value)
        destPath = Trim(ws.Cells(i, "B").Value)
        
        ' 跳过空行
        If sourcePath = "" Or destPath = "" Then GoTo NextRow
        
        ' 检查源文件是否存在
        If Dir(sourcePath) = "" Then
            MsgBox "源文件不存在：" & sourcePath, vbExclamation
            GoTo NextRow
        End If
        
        ' 提取目标路径的文件夹部分，自动创建文件夹
        destFolder = Left(destPath, InStrRev(destPath, "\"))
        If Dir(destFolder, vbDirectory) = "" Then
            MkDir destFolder
            ' 如果需要创建多级文件夹，把上面的MkDir换成下面的CreateFolder函数调用
            ' CreateFolder destFolder
        End If
        
        ' 执行复制，加错误捕获
        On Error Resume Next
        FileCopy sourcePath, destPath
        If Err.Number <> 0 Then
            MsgBox "复制失败：" & sourcePath & vbCrLf & "错误原因：" & Err.Description, vbCritical
        End If
        On Error GoTo 0
        
NextRow:
    Next i
    
    MsgBox "批量复制完成！", vbInformation
End Sub

' 可选：创建多级文件夹的辅助函数（如果目标路径有多层未创建的文件夹）
Private Sub CreateFolder(fullPath As String)
    Dim folders() As String
    Dim tempPath As String
    Dim i As Integer
    
    folders = Split(fullPath, "\")
    tempPath = folders(0) & "\"
    
    For i = 1 To UBound(folders)
        tempPath = tempPath & folders(i) & "\"
        If Dir(tempPath, vbDirectory) = "" Then
            MkDir tempPath
        End If
    Next i
End Sub

使用步骤 #

1. 在Excel中整理数据：A列填完整源文件路径，B列填完整目标文件路径，第一行可设表头（比如“源路径”“目标路径”）
2. 按Alt+F11打开VBA编辑器，插入一个新模块，把上面的代码粘贴进去
3. 返回Excel，按Alt+F8选择BatchFileCopy执行

注意事项 #

• 确保Excel启用宏（文件另存为.xlsm格式）
• 路径中不要包含特殊字符或全角符号
• 如果复制大文件或大量文件，耐心等待，不要中途关闭Excel
• 若遇到权限问题，右键以管理员身份打开Excel

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