无需等待

**：

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

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文件

由于

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

无需等待

4 个答案: