VBA複数の場所にコードを適用する

Question

こんにちは私は、特定のフォルダから単一のフォルダにファイルをコピーするマクロを持っています。私が持っているコードが、1つのループ内の複数の指定されたフォルダ私はすべての単一のフォルダパス/ファイルのための新しいモジュールを作成する必要があります。

私は次のコードを持っている：任意の助けをいただければ幸いです

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

別のフォルダからコピーする場合は、コレクションを使用することができます。私はちょうど私がちょうど `collFrFldr.Addを持つ別のラインを入れて、私からファイルをコピーする必要があるすべてのフォルダ「\\さらに別のフォルダ」`右たびに追加のであれば

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