如何通過查找位置將文件複製到另一個文件夾

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 

末次

但上面的代碼不復制文件！

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 

這將具有相同文件名的文件移動到名爲YourFolder的文件夾Desktop中的新位置。
希望這會有所幫助。

EDIT1：

如果你只有帶擴展名的文件名

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的文件名應該有extension名稱（如Sample.xlsx，TEXT.TXT。） 。

Answer 2

不打算寫你的代碼你，但這些可能幫助

• http://msdn.microsoft.com/en-us/library/office/aa221353(v=office.11).aspx
• Excel VBA - read cell value from code
• VBA check if file exists
• VBA to copy a file from one directory to another