r/excel - 将文件和文件夹复制到基于 Excel 列表的位置 我正在尝试将基于 Excel 中的源列的文件和文件夹列表复制到新位置。我有一个需要复制的文件和文件夹的 Excel 列表,并保留部分原始路径(参见屏幕截图)所需的结果。
我已经走到这一步了,但我不断收到错误 -运行时错误 52:错误的文件名或编号
这是我的代码:
Sub CopyFilesAndFolders()
Dim wb As Workbook
Dim ws As Worksheet
Dim sourceFolder As String
Dim destFolder 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
' Define the source folder
sourceFolder = "C:\Users\pc50\Desktop\Source"
' Open the Excel file containing the list
Set wb = Workbooks.Open("C:\Users\pc50\Desktop\FF2.xlsx")
Set ws = wb.Sheets("Sheet1") ' Change "Sheet1" to your sheet name
' Loop through the rows in the Excel sheet
For i = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' Read values from Excel sheet
fileName = ws.Cells(i, 1).Value
folderName = ws.Cells(i, 2).Value
destinationFolder = ws.Cells(i, 3).Value
' Construct source and destination paths
sourcePath = sourceFolder & fileName
destPath = destinationFolder
' Check if destination folder exists, create if not
Debug.Print sourcePath & vbLf & destPath
If Dir(destPath, vbDirectory) = "" Then
MkDir destPath
End If
' Copy file to destination
FileCopy sourcePath, destPath
Next i
' Close the Excel file
wb.Close SaveChanges:=False
End Sub