VBA为多个位置应用代码

你好，我有一个macros，从特定的文件夹复制文件到一个文件夹，我想知道我的代码是否可以改变从一个循环内多个指定的文件夹拉多个文件，因为现在我必须为每个创build一个新的模块单个文件夹path/文件。

我有以下代码：

Sub SmplAPP() Dim FSO As Object Dim FrFldr As String Dim ToFldr As String Dim myVal1 As Variant Dim myValn As String myVal1 = InputBox("Please enter today's date in mm-dd format") myValn = Replace(myVal1, "-", "\") Range("I1").Value = myValn FrFldr = "\\xxxf003\sample_data\SAMPLE_REPORTS\APPS\Reports\Regional\SAMPLE_APPLICATION\2017\" & myValn ToFldr = "C:\Users\sample\Desktop\logs_to_upload" If Right(FrFldr, 1) = "\" Then FrFldr = Left(FrFldr, Len(FrFldr) - 1) End If If Right(ToFldr, 1) = "\" Then ToFldr = Left(ToFldr, Len(ToFldr) - 1) End If Set FSO = CreateObject("scripting.filesystemobject") If FSO.FolderExists(FrFldr) = False Then MsgBox FrFldr & " doesn't exist" Exit Sub End If FSO.CopyFolder Source:=FrFldr, Destination:=ToFldr Call NextApp End Sub 

任何帮助将不胜感激！

Answer 1

如果你想从不同的文件夹复制，你可以使用收集。 我修改了你的子程序：

 Sub SmplAPP() Dim FSO As Object Dim collFrFldr As New Collection Dim FrFldr As Variant Dim ToFldr As String Dim myVal1 As Variant Dim myValn As String myVal1 = InputBox("Please enter today's date in mm-dd format") myValn = Replace(myVal1, "-", "\") Range("I1").Value = myValn collFrFldr.Add "\\xxxf003\sample_data\SAMPLE_REPORTS\APPS\Reports\Regional\SAMPLE_APPLICATION\2017\" & myValn collFrFldr.Add "\\another folder" collFrFldr.Add "\\yet another folder" ToFldr = "c:\Users\u195567\test\" If Right(ToFldr, 1) = "\" Then ToFldr = Left(ToFldr, Len(ToFldr) - 1) End If Set FSO = CreateObject("scripting.filesystemobject") For Each FrFldr In collFrFldr If Right(FrFldr, 1) = "\" Then FrFldr = Left(FrFldr, Len(FrFldr) - 1) End If If FSO.FolderExists(FrFldr) = False Then MsgBox FrFldr & " doesn't exist" Exit Sub End If FSO.CopyFolder Source:=FrFldr, Destination:=ToFldr Next FrFldr Call NextApp End Sub