Question

我搜索了很多不同/类似的主题，但非能够帮助我达到我需要做的事情。

我在A列中有一个文件路径列表，我需要将每个文件复制到一个目录中，该目录具有完全相同的文件夹路径（如备份还原）。

因此，一个宏循环遍历列a并将列复制到一个文件并将其粘贴到列B位置

A栏

C ：\用户\用户\桌面\测试\ TEST1 \ test1d.txt

C：\用户\用户\桌面\测试\ TEST2 \ test2d.txt

C：\用户\用户\桌面\测试\ TEST3 \ test3d.txt ...

B栏

d ：\用户\用户\桌面\测试\ TEST1 \

d：\用户\用户\桌面\测试\ TEST2 \

d：\用户\用户\桌面\测试\ TEST3 \

...

我知道一个接一个地做起来很容易，但我需要基本上复制和粘贴它们的8000多个文件。到一个上面有180GB文件的驱动器。

Answer 1

循环遍历行并使用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

我不知道您是否需要目的地的文件名，因为我从未使用过FileCopy功能，但是如果您这样做，我确信您可以从A栏获取它，而无需我的帮助。提示使用Split和Ubound来获取它

Answer 2

请这样试试。

复制或移动一个文件

对于一个文件，您可以使用VBA名称和FileCopy功能，对于整个文件夹或许多文件，请使用此页面上的其他宏示例。

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

复制或移动更多文件或完整文件夹

注意：阅读代码中注释的代码行

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

您可以使用以下链接找到所有详细信息。

http://www.rondebruin.nl/win/s3/win026.htm

Answer 3

确定，

所以从我能够完成的，这里是我操纵的代码 excel vba macro copy multiple files from folder to folder

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

Answer 4

下面的代码对我来说很好用。但是它无法从子文件夹复制文件

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

Excel VBA宏，用于根据列中的文件路径将文件从一个位置复制到另一个位置

4 个答案: