基于Excel列表复制文件文件夹时遇Run-time error 52错误

错误核心原因 #

Run-time Error 52本质是文件路径或文件名无效，你的代码存在几个关键逻辑漏洞导致该错误：

具体修复步骤 #

• 路径拼接缺少分隔符
  源文件夹与文件名拼接时未添加路径分隔符\，会生成C:\Users\pc50\Desktop\Sourcefilename.txt这类无效路径。修改拼接代码：

  sourcePath = sourceFolder & "\" & fileName
  

• FileCopy目标参数错误
  FileCopy要求第二个参数是完整的目标文件路径（含文件名），而非单纯的文件夹路径。你当前直接传入文件夹路径，会触发错误。需补充文件名：

  destPath = destinationFolder & "\" & fileName
  

• 未处理文件夹复制需求
  原代码中folderName变量未被使用，且FileCopy仅能复制文件，无法处理文件夹复制。若需复制文件夹，需引入FileSystemObject（需先在VBA编辑器中勾选「Microsoft Scripting Runtime」引用）：

  ' 顶部添加变量声明
  Dim fso As FileSystemObject
  Set fso = New FileSystemObject
  
  ' 循环内添加文件夹复制逻辑
  If folderName <> "" Then
      Dim sourceFolderPath As String, destFolderPath As String
      sourceFolderPath = sourceFolder & "\" & folderName
      destFolderPath = destinationFolder & "\" & folderName
      If Not fso.FolderExists(destFolderPath) Then
          fso.CreateFolder destFolderPath
      End If
      ' 复制文件夹内所有内容（含子文件夹），True表示覆盖
      fso.CopyFolder sourceFolderPath, destFolderPath & "\", True
  End If
  

• 增加空值校验
  避免Excel空单元格生成无效路径，在循环内添加跳过逻辑：

  If fileName = "" Or destinationFolder = "" Then
      GoTo SkipRow
  End If
  

完整修复后的代码 #

Sub CopyFilesAndFolders()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim sourceFolder As String
    Dim fileName As String
    Dim folderName As String
    Dim destinationFolder As String
    Dim sourcePath As String
    Dim destPath As String
    Dim i As Long
    Dim fso As FileSystemObject
    
    Set fso = New FileSystemObject

    ' 定义源文件夹
    sourceFolder = "C:\Users\pc50\Desktop\Source"

    ' 打开包含列表的Excel文件
    Set wb = Workbooks.Open("C:\Users\pc50\Desktop\FF2.xlsx")
    Set ws = wb.Sheets("Sheet1") ' 改为你的工作表名称

    ' 遍历Excel行
    For i = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        ' 读取单元格值
        fileName = ws.Cells(i, 1).Value
        folderName = ws.Cells(i, 2).Value
        destinationFolder = ws.Cells(i, 3).Value

        ' 跳过空行
        If fileName = "" Or destinationFolder = "" Then
            GoTo SkipRow
        End If

        ' 构建文件源路径和目标路径
        sourcePath = sourceFolder & "\" & fileName
        destPath = destinationFolder & "\" & fileName

        ' 检查目标文件夹是否存在，不存在则创建
        If Not fso.FolderExists(destinationFolder) Then
            fso.CreateFolder destinationFolder
        End If

        ' 复制文件（存在则覆盖）
        If fso.FileExists(sourcePath) Then
            fso.CopyFile sourcePath, destPath, True
        End If

        ' 复制文件夹（如果有指定）
        If folderName <> "" Then
            Dim sourceFolderPath As String, destFolderPath As String
            sourceFolderPath = sourceFolder & "\" & folderName
            destFolderPath = destinationFolder & "\" & folderName
            If fso.FolderExists(sourceFolderPath) Then
                fso.CopyFolder sourceFolderPath, destFolderPath & "\", True
            End If
        End If

SkipRow:
    Next i

    ' 关闭Excel文件
    wb.Close SaveChanges:=False
    Set fso = Nothing
End Sub

额外注意事项 #

• 运行前需在VBA编辑器中：点击「工具」→「引用」→勾选Microsoft Scripting Runtime
• 确认源文件/文件夹真实存在，避免路径拼写错误
• 确保目标路径有写入权限，否则会触发权限错误

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