VBA实现从一个文件夹复制多个选定文件到另一个文件夹

我看了你的代码，发现几个导致无法正常复制的问题，比如用了移动文件的语句而非复制、没过滤JPG文件、目标路径没做校验等等。下面是修正后的代码，完全贴合你的需求：

Sub CopyJPGFiles()
    Dim xDir As String
    Dim xFile As String
    Dim xRow As Long
    Dim FSO As Object
    Dim ToPath As String
    Dim ws As Worksheet
    
    ' 替换成你的目标文件夹路径，记得末尾要加反斜杠\
    ToPath = "C:\你的目标文件夹路径\"
    Set ws = ThisWorkbook.Worksheets("Files to Copy")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    ' 先检查目标文件夹是否存在，不存在就自动创建
    If Not FSO.FolderExists(ToPath) Then
        FSO.CreateFolder (ToPath)
    End If
    
    ' 让你选择要复制的源文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = -1 Then
            xDir = .SelectedItems(1)
            ' 只遍历文件夹里的.jpg文件，避免处理其他类型
            xFile = Dir(xDir & Application.PathSeparator & "*.jpg", vbNormal)
            
            Do Until xFile = ""
                ' 在A列查找当前文件名，临时开启错误处理避免找不到时报错
                On Error Resume Next
                xRow = Application.Match(xFile, ws.Range("A:A"), 0)
                On Error GoTo 0 ' 用完就关闭错误处理，别掩盖其他问题
                
                If xRow > 0 Then
                    Dim targetFileName As String
                    ' 如果B列有自定义名字就用，没有就保留原文件名
                    targetFileName = IIf(ws.Cells(xRow, "B").Value <> "", ws.Cells(xRow, "B").Value, xFile)
                    
                    ' 确保目标文件名带.jpg后缀，防止B列输入时漏加
                    If LCase(Right(targetFileName, 4)) <> ".jpg" Then
                        targetFileName = targetFileName & ".jpg"
                    End If
                    
                    ' 执行复制，最后一个True表示如果目标有重名文件就覆盖
                    FSO.CopyFile Source:=xDir & Application.PathSeparator & xFile, _
                                Destination:=ToPath & targetFileName, _
                                OverWriteFiles:=True
                End If
                
                xFile = Dir ' 切换到下一个JPG文件
            Loop
            MsgBox "指定的JPG文件已经复制完成啦！", vbInformation
        End If
    End With
    
    ' 释放占用的对象，避免内存浪费
    Set FSO = Nothing
    Set ws = Nothing
End Sub

为啥原代码不行？我给你捋捋 #

• 你用的Name语句是移动文件，不是复制，这和你的需求完全反了
• 原代码会遍历文件夹里所有文件，没限定只处理.jpg
• 目标路径ToPath是占位符，而且没检查文件夹是否存在，不存在就会直接报错
• 定义了FSO对象但没实例化也没用到，属于冗余代码
• 错误处理太宽泛，可能掩盖其他真正的问题

用的时候注意这几点 #

1. 一定要把ToPath里的占位路径换成你实际要复制到的文件夹路径，末尾必须加\
2. 确保Files to Copy工作表的A列是需要复制的JPG文件名（要带.jpg后缀哦）
3. B列可以填自定义文件名，要是留空就会用原文件名复制；就算你B列没加.jpg，代码也会自动补上

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