Блог

 Sub CheckandSend()
    Dim strfile As String
    Dim ws As Worksheet 'make sure to define a sheet
    Set ws = ThisWorkbook.Worksheets("RFQ")
    Sheets("Part list").Select
    Sheets("RFQ").Select
    Dim lastrow As Long
    lastrow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    Range("A6:E" amp; lastrow).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Part list").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Cells.Select
    Cells.EntireColumn.AutoFit
Dim Worksheet2_Name As String
WorkRFQ_Name = "Part list" ' Replace this with the name of the first sheet you want to export
Set WorkRFQ = ThisWorkbook.Worksheets(WorkRFQ_Name)
Dim Write_Directory As String
Dim WorkRFQ_Path As String
Write_Directory = "P:CENTRAL PLANNINGPROJECTS 2020-2021VAM-TARSONNewfolder1" 
WorkRFQ_Path = Write_Directory amp; "" amp; WorkRFQ_Name
WorkRFQ.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    FileName:=WorkRFQ_Path, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
    
    Sheets("Part list").Select
    Columns("A:Z").Select
    Selection.Delete
    Sheets("RFQ").Select
    Dim SourcePath As String
    SourcePath = "I:MechanicalExternalProjectsCummins Emission Systems35101124 PT Cup Test Rig16 PDF to Vendor"
    Dim DestPath As String
    DestPath = "P:CENTRAL PLANNINGPROJECTS 2020-2021VAM-TARSONNewfolder1"

    Dim irow As Long
    Dim f As SearchFolders
    Dim filetype As String
    filetype = "*.pdf"
    irow = 7
    
    Do While ws.Cells(irow, 2) <> vbNullString
        Dim FileName As String
        FileName = Dir(SourcePath amp; ws.Cells(irow, 2) amp; "*.pdf")
       
        Do While FileName <> vbNullString
            VBA.FileCopy SourcePath amp; FileName, DestPath amp; FileName
            FileName = Dir()
        Loop
        
        irow = irow   1
    Loop
end sub
 

На вот, этот код поможет мне найти PDF-файл, который присутствует в моей параметр sourcepath amp; штепсельной вилки, что и файл место в моем destpath
теперь, где я нахожусь отстает, на мой источник (в формате PDF поставщика») после этой папке есть несколько вложенных папок , я хочу, чтобы код, который перебора всех подпапок и файлов и поместить его в мой дест пути

мои вложенные папки будут выглядеть как OP10, OP20, OP30….. И т.д…,

Вот функция, которая вернет коллекцию совпадающих file объектов с заданным начальным местоположением и шаблоном имени файла:

 'Return a collection of file objects given a starting folder and a file pattern
'  e.g. "*.txt"
'Pass False for last parameter if don't want to check subfolders
Function FileMatches(startFolder As String, filePattern As String, _
                    Optional subFolders As Boolean = True) As Collection

    Dim fso, fldr, f, subFldr
    Dim colFiles As New Collection  '<< all matched files
    Dim colSub As New Collection    '<< folders to be scanned for matching files
    
    Set fso = CreateObject("scripting.filesystemobject")
    colSub.Add startFolder   '<< add the starting folder
    
    'loop while there are still folders to be scanned
    Do While colSub.Count > 0
        Set fldr = fso.getfolder(colSub(1))
        colSub.Remove 1   '<< remove the folder we're now scanning from the list
        For Each f In fldr.Files 'get files in folder
            'if the filename is like the pattern, add to the "hits" collection
            If UCase(f.Name) Like UCase(filePattern) Then colFiles.Add f
        Next f
        If subFolders Then 'get subfolders for processing?
            For Each subFldr In fldr.subFolders
                colSub.Add subFldr.Path  '<< add subfolder to list for processing
            Next subFldr
        End If
    Loop
    Set FileMatches = colFiles 'return all matched files
End Function
 

Пример использования на основе вашего опубликованного кода:

 
    Dim SourcePath As String, DestPath As String
    Dim colFiles as Collection, f

    SourcePath = "I:MechanicalExternalProjectsCummins Emission Systems35101124 PT Cup Test Rig16 PDF to Vendor"
    
    DestPath = "P:CENTRAL PLANNINGPROJECTS 2020-2021VAM-TARSONNewfolder1"

    Dim irow As Long
    Dim f As SearchFolders
    Dim filetype As String
    filetype = "*.pdf"
    irow = 7
    
    Do While ws.Cells(irow, 2) <> vbNullString
        
        Set colFiles = FileMatches(SourcePath, ws.Cells(irow, 2) amp; "*.pdf")
        For Each f in colFiles
            f.Copy DestPath amp; f.Name
        Next f
        
        irow = irow   1
    Loop