VBA - 根据单元格值将带有前缀的文件复制到多个目标

Question

第一次来这个论坛，希望有人能帮助我......

我正在尝试将带有 TT Plan 前缀的任何及所有 pdf 文件从单个源文件夹（在单元格 C3 中指定）复制到基于特定主目录的一系列目标文件夹，然后将子文件夹名称作为单元格中的作业编号无论我有多少工作号码，B8 都是如此。

下面是我正在尝试的内容，尽管我知道目标文件夹的设置不正确。

Sub CopyFiles()

    Dim LastRowInA As Long
    Dim Cel As Range
    Dim Rng As Range
    Dim DestinationFolder As String
    Dim FileExtention As String
    Dim SourceFile As String
    Dim SourceFolder As String

    On Error Resume Next

    SourceFolder = TTPlanCopy.Range("C4") & "\"
    FileExtention = "pdf"
    DestinationFolder = "F:\UFP Design\Report Testing\Jobs\"


    If Dir(DestinationFolder, vbDirectory) = 0 Then
        MsgBox ("Job Folder does not exist")
        Exit Sub
    End If

    SourceFile = Dir(SourceFolder & "TT Plan*." & FileExtention)

    LastRowInB = Range("B" & Rows.Count).End(xlUp).Row

    Set Rng = Range("B8:B" & LastRowInB)

    With Rng
        For Each Cel In Rng
        Do While SourceFile Like "TT Plan*"
        FileCopy SourceFolder & SourceFile, DestinationFolder & Cel
        SourceFile = Dir
        Loop
        Next
    End With
End Sub

Answer 1

尝试这样的事情：

Sub CopyFiles()

    Const FILE_EXT As String = "pdf" 'use Const for fixed values
    
    Dim DestinationFolder As String, DestSub As Range
    Dim FileExtention As String
    Dim SourceFile As String
    Dim SourceFolder As String

    SourceFolder = Trim(TTPlanCopy.Range("C4"))
    If Right(SourceFolder, 1) <> "\" Then SourceFolder = SourceFolder & "\"

    DestinationFolder = "F:\UFP Design\Report Testing\Jobs\"

    If Len(Dir(DestinationFolder, vbDirectory)) = 0 Then
        MsgBox ("Job Folder does not exist")
        Exit Sub
    End If

    SourceFile = Dir(SourceFolder & "TT Plan*." & FileExtention)
    Set DestSub = TTPlanCopy.Range("B8") 'first destination sub folder cell
    
    Do While Len(SourceFile) > 0 And Len(DestSub.Value) > 0
        FileCopy SourceFolder & SourceFile, DestinationFolder & DestSub.Value
        SourceFile = Dir
        Set DestSub = DestSub.Offset(1) 'next destination
    Loop
    
End Sub