![]()
Sub ProcessPDFs() Dim SrcSht As Worksheet Dim PMDateRec As Worksheet Dim oFSO As Object Dim PDFFolder As Object Dim PDFFile As Object Dim Parts As Variant Dim DateCol As Variant Dim Prefix As String Dim PrefixRow As Variant Dim FolderPath As String Dim DestRow As Variant Dim DestCol As Long Set SrcSht = Worksheets("sheet1") Set PMDateRec = Sheets("pm date") FolderPath = "C:\2023-01" Set oFSO = CreateObject("Scripting.FileSystemObject") Set PDFFolder = oFSO.GetFolder(FolderPath) For Each PDFFile In PDFFolder.Files If UCase(Right(PDFFile.Name, 3)) = "PDF" Then Parts = Split(Left(PDFFile.Name, Len(PDFFile.Name) - 4), " ") Prefix = Parts(0) & "-" & Parts(1) ' update PM With SrcSht Set PrefixRow = .Columns("D").Find(Prefix) Parts = DateValue(Parts(2)) Set DateCol = .Range("2:2").Find(Parts) .Cells(PrefixRow.Row, DateCol.Column) = "PM" End With 'source sheet 'put PM dates With PMDateRec Set DestRow = .Columns("D").Find(Prefix) DestCol = .Cells(DestRow.Row, .Columns.Count).End(xlToLeft).Column + 1 .Cells(DestRow.Row, DestCol).Value = Format(Date, "dd-mmm") End With End If Next PDFFile End Sub
Bookmarks