如何用VBA将指定Excel文件列表复制到目标文件夹（问题排查）

问题根源 #

1. 目标路径缺少路径分隔符：BrowseForFolder返回的文件夹路径通常不带末尾的反斜杠\，直接把这个路径传给FSO.CopyFile时，FSO会将第一个源文件的内容覆盖到以sDest命名的文件里（没有扩展名，所以显示为file类型），后续文件因为目标是已存在的文件而非文件夹，导致复制失败。
2. 数组声明语法不规范：VBA中数组构造函数是Array()（首字母大写），虽然部分环境允许小写，但严格写法能避免潜在语法问题。

修正后的完整代码 #

Sub Copyfiles_to_folder()
    Dim sSource As Variant
    Dim sDest As String
    Dim FSO As New FileSystemObject
    Dim vYearFolder As Variant
    Dim Directory As Variant
    
    ' 选择目标文件夹
    vYearFolder = BrowseForFolder("K:\FolderSource")
    If vYearFolder = "" Then Exit Sub ' 用户取消选择则退出
    
    ' 确保目标路径末尾带有反斜杠
    sDest = vYearFolder
    If Right(sDest, 1) <> "\" Then sDest = sDest & "\"
    
    ' 待复制的Excel文件列表
    Directory = Array("P:\file1.xlsm", "P:\file2.xlsm", "P:\file3.xlsm", "P:\file4.xlsm")
    
    ' 遍历复制每个文件
    For Each sSource In Directory
        ' 检查源文件是否存在，避免报错
        If FSO.FileExists(sSource) Then
            FSO.CopyFile sSource, sDest, True
        Else
            MsgBox "文件不存在：" & sSource, vbExclamation
        End If
    Next
End Sub

' 文件夹选择对话框实现
Function BrowseForFolder(Optional strPath As String) As String
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    
    With fd
        .Title = "选择目标文件夹"
        .InitialFileName = strPath
        If .Show = -1 Then
            BrowseForFolder = .SelectedItems(1)
        Else
            BrowseForFolder = ""
        End If
    End With
    
    Set fd = Nothing
End Function

关键修正说明 #

• 添加路径分隔符：通过Right(sDest, 1) <> "\"判断，给目标路径补上末尾的\，让FSO明确识别这是一个文件夹路径，而非文件名。
• 增加文件存在检查：避免因源文件不存在导致宏报错中断，同时给出提示。
• 完善文件夹选择逻辑：处理用户取消选择的情况，防止后续代码执行出错。

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