VBA -复制多个文件(下载后1.2.3.)计数到一个文件夹

Question

我需要帮助复制多个文件到一个文件夹后下载。

下载后文件默认重命名为:

• Branch_A.xlsx
• Branch_A (1) .xlsx
• Branch_A (2) .xlsx

这里的代码通常我使用，但这段代码只复制一个文件到一个文件夹。我需要的代码可以捕获文字"Branch_A"然后计数文件并复制到Branch_A文件夹。计数文件是修复3，它将出现4..5..6..

Sub down1()
'RENAME FILE DOWNLOAD BY BRANCHES
Dim Ws As Worksheet
Dim FromPath As String
Dim ToPath As String
    
Set Ws = ThisWorkbook.Worksheets("Path_Down1")
'FROM DOWNLOAD - C:UsersDownloads
FromPath = Ws.Range("E11").Value
'TO FOLDER - D:InboundBranch_A
ToPath = Ws.Range("F11").Value
Ws.Activate
FileCopy FromPath, ToPath

End Sub

我搜索了几个网站，发现代码可以根据扩展名计算文件，但我不知道如何编辑按名称计数并复制到文件夹。下面是示例代码:

Sub sample()
    Dim FolderPath As String, path As String, count As Integer
    FolderPath = "C:Documents and SettingsSantoshDesktop"
    path = FolderPath & "*.xls"
    Filename = Dir(path)
    Do While Filename <> ""
       count = count + 1
        Filename = Dir()
    Loop
    Range("Q8").Value = count
    'MsgBox count & " : files found in folder"
End Sub

谢谢你的帮助。

Answer 1

下面的代码是你正在寻找的东西吗?这是我能想到的对我来说有意义的东西。如果没有，请提供更多的信息，说明是什么问题。

Sub Down1()
    Dim FromFolder As String, ToFolder As String
    Dim FromPath As String, ToPath As String, ws As Worksheet
    
    Set ws = ThisWorkbook.Worksheets("Path_Down1")
    FromFolder = ws.Range("E11").Value
    ToFolder = ws.Range("F11").Value
    Filename = Dir(FromFolder & "*.xlsx")
    
    Do While Filename <> ""
        If InStr(Filename, "Branch_A") > 0 Then
            FromPath = FromFolder & "" & Filename
            ToPath = ToFolder & "" & Filename
            
            FileCopy FromPath, ToPath
        End If
        Filename = Dir()
    Loop
    
End Sub