vba 根据列中的文件路径将文件从一个位置复制到另一个位置
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/37172787/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Copy files from one location to another based off file path in column
提问by mkn95u0
I have a list of files, with file paths, in column A.
我在 A 列中有一个带有文件路径的文件列表。
I need to copy each file into a directory that has the same folder path (like a backup being restored).
我需要将每个文件复制到具有相同文件夹路径的目录中（例如正在恢复的备份）。
How do I loop through column A and copy each file to column B's location?
如何遍历 A 列并将每个文件复制到 B 列的位置？
Column A
A栏
C:\Users\user\Desktop\Test\test1\test1d.txt
C:\Users\user\Desktop\Test\test1\test1d.txt
C:\Users\user\Desktop\Test\test2\test2d.txt
C:\Users\user\Desktop\Test\test2\test2d.txt
C:\Users\user\Desktop\Test\test3\test3d.txt
C:\Users\user\Desktop\Test\test3\test3d.txt
...
...
Column B
B栏
D:\Users\user\Desktop\Test\test1\
D:\用户\用户\桌面\测试\测试1\
D:\Users\user\Desktop\Test\test2\
D:\用户\用户\桌面\测试\测试2\
D:\Users\user\Desktop\Test\test3\
D:\用户\用户\桌面\测试\test3\
...
...
I searched quite a few topics, but none were able to help me get to what I need to do.
我搜索了很多主题，但没有一个能够帮助我找到我需要做的事情。
回答by Dan Donoghue
Loop through the rows and use FileCopy, something like (I am free typing this so you may need to debug)
循环遍历行并使用 FileCopy，例如（我可以随意输入此内容，因此您可能需要调试）
Sub CopyFiles
Dim X as long
For X = 2 to range("A" & Rows.count).end(xlup).row 'Change 2 to 1 if you don't have headers
FileCopy Range("A" & X).Text Range("B" & X).Text
Next
End Sub
I don't know if you will need the file name on the destination as I have never used the FileCopy function but if you do I am sure you can source it from Column A without needing help from me. Hintuse Split and Ubound to get it
我不知道您是否需要目标上的文件名，因为我从未使用过 FileCopy 功能，但如果您使用了，我相信您可以从 A 列获取它，而无需我的帮助。提示使用 Split 和 Ubound 来获取它
回答by ASH
Please try it like this.
请像这样尝试。
Copy or Move one file
复制或移动一个文件
For one file you can use the VBA Name and FileCopy function and for entire folders or a lot of files use the other macro example's on this page.
对于一个文件，您可以使用 VBA 名称和文件复制功能，对于整个文件夹或大量文件，您可以使用此页面上的另一个宏示例。
Sub Copy_One_File()
FileCopy "C:\Users\Ron\SourceFolder\Test.xls", "C:\Users\Ron\DestFolder\Test.xls"
End Sub
Sub Move_Rename_One_File()
'You can change the path and file name
Name "C:\Users\Ron\SourceFolder\Test.xls" As "C:\Users\Ron\DestFolder\TestNew.xls"
End Sub
Copy or move more files or complete folders
复制或移动更多文件或完整文件夹
Note: Read the commented code lines in the code
注意：阅读代码中注释的代码行
Sub Copy_Folder()
'This example copy all files and subfolders from FromPath to ToPath.
'Note: If ToPath already exist it will overwrite existing files in this folder
'if ToPath not exist it will be made for you.
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
FromPath = "C:\Users\Ron\Data" '<< Change
ToPath = "C:\Users\Ron\Test" '<< Change
'If you want to create a backup of your folder every time you run this macro
'you can create a unique folder with a Date/Time stamp.
'ToPath = "C:\Users\Ron\" & Format(Now, "yyyy-mm-dd h-mm-ss")
If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If
If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
FSO.CopyFolder Source:=FromPath, Destination:=ToPath
MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath
End Sub
You can find all details using the link below.
您可以使用下面的链接找到所有详细信息。
回答by mkn95u0
Here is the code I manipulated from excel vba macro copy multiple files from folder to folder
这是我从excel vba 宏操作的代码 将多个文件从文件夹复制到文件夹
Sub copy()
Dim r As Long
Dim SourcePath As String
Dim dstPath As String
Dim myFile As String
On Error GoTo ErrHandler
For r = 2 To Range("A" & Rows.Count).End(xlUp).Row
SourcePath = Range("C" & r)
dstPath = Range("D" & r)
myFile = Range("A" & r)
FileCopy SourcePath & "\" & myFile, dstPath & "\" & myFile
If Range("A" & r) = "" Then
Exit For
End If
Next r
MsgBox "The file(s) can found in: " & vbNewLine & dstPath, , "COPY COMPLETED"
ErrHandler:
MsgBox "Copy error: " & SourcePath & "\" & myFile & vbNewLine & vbNewLine & _
"File could not be found in the source folder", , "MISSING FILE(S)"
Range("A" & r).copy Range("F" & r)
Resume Next
End Sub
回答by Jay
Below code works fine for me. But it is not able to copy files from Sub Folders
下面的代码对我来说很好用。但它无法从子文件夹复制文件
Sub copy() Dim r As Long
Dim SourcePath As String
Dim dstPath As String
Dim myFile As String
On Error GoTo ErrHandler
For r = 2 To Range("A" & Rows.Count).End(xlUp).Row
SourcePath = Range("C" & r)
dstPath = Range("D" & r)
myFile = Range("A" & r)
FileCopy SourcePath & "\" & myFile, dstPath & "\" & myFile
If Range("A" & r) = "" Then
Exit For
End If
Next r
MsgBox "The file(s) can found in: " & vbNewLine & dstPath, , "COPY COMPLETED" ErrHandler:
MsgBox "Copy error: " & SourcePath & "\" & myFile & vbNewLine & vbNewLine & _
"File could not be found in the source folder", , "MISSING FILE(S)" Range("A" & r).copy Range("F" & r) Resume Next End Sub
