excelvbapdflocation

Search the latest saved PDF file in a various folders and copy the latest one to a specific location

I need a VBA Excel macro to find the latest saved PDF file in the folders and sub folder to get the latest (Creation date and time), then that needs to copy to a specific location.

The code below works only in the main folder, not in sub folders. Also, the file is being copyied from the source path, but not pasted into the destination path.

Sub copy_files_from_subfolders()
    Dim fso As Object
    Dim fld As Object
    Dim fsofile As Object
    Dim fsofol As Object

    SourcePath = "C:\Users\OneDrive - Corporation\"
    destinationpath = "Z:\Project\Task 17"

    If Right(SourcePath, 1) <> "\" Then
    SourcePath = SourcePath & "\"
    End If

    Set fso = CreateObject("scripting.filesystemobject")
    Set fld = fso.GetFolder(SourcePath)
    If fso.FolderExists(fld) Then
        For Each fsofol In fso.GetFolder(SourcePath).SubFolders
            For Each fsofile In fsofol.Files
                If Right(fsofile, 10) = "R-001-002.PDF" Then
                fsofile.Copy destinationpath
            End If
            Next
        Next
    End If
End Sub
Solution

  • I have checked the below code; Note that the first var fso is a public var so its placed outside the subs.

    Dim fso As Object


Sub CopyFilesFromSubfolders()

Dim LatestFile As String
Dim LatestDate As Date
Dim SourcePath As String
Dim DestinationPath As String

SourcePath = "C:\Data\Temp\pdf\test"
DestinationPath = "C:\Data\Temp\pdf"

Set fso = CreateObject("Scripting.FileSystemObject")

LatestFile = ""
LatestDate = #1/1/1900#
Call FindLatestPdf(fso.GetFolder(SourcePath), LatestFile, LatestDate)

If LatestFile <> "" Then
    fso.CopyFile LatestFile, DestinationPath & fso.GetFileName(LatestFile)
    MsgBox "Copied: " & fso.GetFileName(LatestFile), vbInformation
Else
    MsgBox "No PDF files found.", vbExclamation
End If
End Sub


Sub FindLatestPdf(fld As Object, ByRef LatestFile As String, ByRef LatestDate As Date)
Dim fsofile As Object
Dim fsofol As Object
Dim CurrentFileDate As Date

   For Each fsofile In fld.Files
    If LCase(fso.GetExtensionName(fsofile)) = "pdf" Then
        CurrentFileDate = fsofile.DateLastModified ' or DateCreated
        If CurrentFileDate > LatestDate Then
            LatestDate = CurrentFileDate
            LatestFile = fsofile.Path
        End If
    End If
Next

' Recursively check subfolders
For Each fsofol In fld.SubFolders
    Call FindLatestPdf(fsofol, LatestFile, LatestDate)
Next
End Sub