Question

我在工作表中有文件名列表（“sheet2”）。我必须检查文件夹中的这些文件，如果文件存在，则应将它们复制到新文件夹。我不知道从哪里开始。任何人都可以指导我吗？

Dim rngFile as Range, cel as Range
Dim desPath as String, filename as String, sourcePath as String

Set rngFile = Thisworkbook.Sheets("Sheet2").Range("A1","A500") ' file list in ColA

desPath = "D:\withdate\" 'Destination folder is withdate
sourcePath = "D:\All\All\(fetch each cell for file name?)" 'source folde

For Each cel in rngFile
    If Dir(sourcePath & cel) <> "" Then
    FileCopy sourcePath & cel, desPath & cel 'copy to folder
End If
Next

End Sub

但上面的代码并没有复制文件！

Answer 1

试试这个：

Dim rngFile as Range, cel as Range
Dim desPath as String, filename as String

Set rngFile = Thisworkbook.Sheets("Sheet2").Range("A1","A500") 'assuming file list in ColA, change to suit

desPath = "C:\User\Username\Desktop\YourFolder\" 'change to a valid path

For Each cel in rngFile
    If Dir(cel) <> "" Then
        filename = Dir(cel) 'Returns the filename
        FileCopy cel, desPath & filename 'copy to folder
    End If
Next

End Sub

这会将具有相同文件名的文件移动到名为Desktop的{{1}}文件夹中的新位置。
希望这会有所帮助。

<强> EDIT1：

如果您只有EXTENSION的文件名

YourFolder

同样，Dim rngFile as Range, cel as Range Dim desPath as String, filename as String, sourcePath as String Set rngFile = Thisworkbook.Sheets("Sheet2").Range("A1","A500") 'assuming file list in ColA, change to suit desPath = "C:\User\Username\Desktop\YourFolder\" 'change to a valid path sourcePath = "C:\Whatever\Here\" For Each cel in rngFile If Dir(sourcePath & cel) <> "" Then FileCopy sourcePath & cel, desPath & cel 'copy to folder End If Next End Sub中的文件名应包含 Sheet2 名称（例如Sample.xlsx，Text.txt）。

Answer 2

不打算为你编写代码，但这些可能会有所帮助

如何通过查找位置将文件复制到另一个文件夹

2 个答案: