Question

您好我有一个宏将特定文件夹中的文件复制到单个文件夹中，我想知道我的代码是否可以更改为从一个循环中的多个指定文件夹中提取多个文件，因为现在我必须创建一个新的每个文件夹路径/文件的模块。

我有以下代码：

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

VBA为多个位置应用代码

1 个答案: