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

时间:2015-03-04 09:38:56

标签: excel vba excel-vba

我想将文件从一个目录复制到其他几个目录,我(使用搜索帮助和准备好的代码)成功完成了这个,问题是:

宏等待完成将所有文件从源复制到目标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

4 个答案:

答案 0 :(得分:0)

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

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

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,汤姆

答案 1 :(得分:0)

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

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

答案 2 :(得分:0)

无需等待

您要做的是生成一个新的子进程(或线程)来执行文件复制:

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

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

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

答案 3 :(得分:0)

解决

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

由于