Excel vba：将文件从一个文件夹同时复制到多个文件夹

Question

我想将文件从一个目录复制到其他几个目录，我（通过搜索帮助和准备好的代码）成功完成了这个，问题是：

宏等待它完成从源到目标1的所有文件复制，然后开始复制到目标2

我要么：

同时将第一个源复制到所有目的地然后移动到源2或开始将所有源文件复制到目标1然后移动以开始将所有源文件复制到目标2 **

没有等待

**：

我使用以下代码进行复制：

Sub All()

    For Each C In Worksheets("Path").Range("A2:A21")
    If C.Value = "" Then GoTo 1
    Call CopyFolder

    Application.ScreenUpdating = True
        Next C

1 
End Sub

'================================================

Sub CopyFolder()
    Dim fso As Object
    Dim FromPath As String
    Dim ToPath As String

    FromPath = "C:\video"  
    ToPath = C & ":\video"    


    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

End Sub

Answer 1

你可以使用这样的东西作为你的第二选择解决方案

我现在无法在我的机器上测试它，但它对我来说似乎是一个很好的解决方案。 （;

FileSystemObject.CopyFile Source:= FromPath +"*.FILEEXTENSION", Destination :=ToPath

如果你的所有文件在“loopability”方面都有相似的名字（比如video1，video2等），你可以使用这样的东西：

Sub CountAndCopyFiles()
Dim fso As Object
Dim FromPath As String
Dim ToPath As String
Dim objFiles As Object
Dim obj As Object
Dim lngFileCount As Long

FromPath = "C:\video"  


Set fso = CreateObject("Scripting.FileSystemObject")
Set objFiles = fso.GetFolder(FromPath).Files

lngFileCount = objFiles.Count

For Each obj In objFiles
  fso.CopyFile Source:= FromPath & obj.Name, Destination:=ToPath
Next obj

Set objFiles = Nothing
Set fso = Nothing
Set obj = Nothing

End Sub

HTH，汤姆

Answer 2

试图制作这个数组，但是等待结果相同：

Sub xArray()

Application.ScreenUpdating = False

    Dim fso As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim Drive(1 To 2) As String
  Drive(1) = "O"
    Drive(2) = "P"
For i = 1 To 2
    FromPath = "C:\video"  
    ToPath = Drive(i) & ":\video"   

    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

Next i

End Sub

Answer 3

没有等待

你想要做的是生成一个新的子进程（或线程）来执行文件复制：

fso.CopyFolder Source:=FromPath, Destination:=ToPath

这样，后台线程可以执行文件复制，而您的代码继续识别要复制的下一个文件并启动该副本。

据我所知，这在原生VBA中是不可能的。 你需要一个像VB或C这样可编辑的语言。有可能会有人知道Windows shell对象，并且可以为你提供一些shell函数调用，允许你生成这些子进程，但它会一个非常深入的编码。

Answer 4

解决了

使用shell命令，我调用了一个进行复制过程的.bat文件

谢谢