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

[kismad]

Hi folks, am stuck with error and am not able to copy the files to the "DestinationPath" could you check and let me what is the error in this code.

>>> use code - tags <<<

Dim fso As Object

Sub CopyFilesFromSubfolders()

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

SourcePath = "D:\TTC"
DestinationPath = "D:\Design\"

Set fso = CreateObject("Scripting.FileSystemObject")

LatestFile = ""

Call FindLatestPdf(fso.GetFolder(SourcePath), LatestFile, LatestDate)

If LatestFile <> "" Then
    fso.copyFile LatestFile, DestinationPath & fso.GetExtensionName(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)) = "r-001-002.pdf" Or _
       UCase(fso.GetExtensionName(fsofile)) = "r-001-002.STEP" Or _
       LCase(fso.GetExtensionName(fsofile)) = "r-001-002.dwg" 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

 

[vletm]

kismad​

What is LatestFile value?
If LatestFile <> "" Then
... are You sure that previous line will give it?

 

[p45cal]

Are the likes of:
"r-001-002.pdf"
"r-001-002.STEP"
"r-001-002.dwg"
the complete names of the files you're looking to move or just the ends of those file names?

 

[kismad]

kismad​

What is LatestFile value?
If LatestFile <> "" Then
... are You sure that previous line will give it?

I use to keep LatestFile = "r-001-002".
but this also doestnot work for me

 

[kismad]

Are the likes of:
"r-001-002.pdf"
"r-001-002.STEP"
"r-001-002.dwg"
the complete names of the files you're looking to move or just the ends of those file names?

file name = r-001-002 and extension is .pdf, So I mention both together

 

[vletm]

kismad​

I tried to ask ... What is it?
You wrote ... You use to keep ... for me, those are different.
Your code do not give that kind of image.
Have You checked ... what is LatestFile value?
Have You test if it always gives MsgBox "No PDF files found.", vbExclamation?
Do Your code give any Err.Number's?

 

[kismad]

kismad​

I tried to ask ... What is it?
You wrote ... You use to keep ... for me, those are different.
Your code do not give that kind of image.
Have You checked ... what is LatestFile value?
Have You test if it always gives MsgBox "No PDF files found.", vbExclamation?
Do Your code give any Err.Number's?

Yes I test the same code and getting "no PDF files found" no files were copied to the location

 

[vletm]

kismad​

"no PDF files found" means LatestFile is empty.
... as I've asked You to check/verify few times.

 

[kismad]

kismad​

"no PDF files found" means LatestFile is empty.
... as I've asked You to check/verify few times.

You mean I should enter LatestFile = "r-001-002" ? am new to VBA kindly suggest me

 

[vletm]

kismad​

Have You copied and pasted Your code somewhere?

 

[WobbleWobble]

Your issue is with the use of fso.GetExtensionName(fsofile) which only looks for the file extension, hence not finding those files in your code.

Try this

Sub CopyFilesFromSubfolders()

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

SourcePath = "D:\TTC"
DestinationPath = "D:\Design\"

Set fso = CreateObject("Scripting.FileSystemObject")

LatestFile = ""

Call FindLatestPdf(fso.GetFolder(SourcePath), LatestFile, LatestDate)

If LatestFile <> "" Then
    fso.copyFile LatestFile, DestinationPath ' & fso.Getfileame(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.GetFileName(fsofile)) = "r-001-002.pdf" Or _
       UCase(fso.GetFileName(fsofile)) = "r-001-002.STEP" Or _
       LCase(fso.GetFileName(fsofile)) = "r-001-002.dwg" Then
      
        CurrentFileDate = fsofile.DateLastModified ' or DateCreated
            If CurrentFileDate > LatestDate Then
                LatestDate = CurrentFileDate
                LatestFile = fsofile.Path
                 ' LatestFile = fsofile.Name
            End If
        End If
    Next


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


End Sub

 

[p45cal]

Is this you:

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 ...

stackoverflow.com

?

 

[kismad]

kismad​

Have You copied and pasted Your code somewhere?

Yes in stackoverflow.com

 

[vletm]

kismad​

Are You Kishore K?

 

[FrankE]

Hi folks, am stuck with error and am not able to copy the files to the "DestinationPath" could you check and let me what is the error in this code.

>>> use code - tags <<<

Dim fso As Object

Sub CopyFilesFromSubfolders()

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

SourcePath = "D:\TTC"
DestinationPath = "D:\Design\"

Set fso = CreateObject("Scripting.FileSystemObject")

LatestFile = ""

Call FindLatestPdf(fso.GetFolder(SourcePath), LatestFile, LatestDate)

If LatestFile <> "" Then
    fso.copyFile LatestFile, DestinationPath & fso.GetExtensionName(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)) = "r-001-002.pdf" Or _
       UCase(fso.GetExtensionName(fsofile)) = "r-001-002.STEP" Or _
       LCase(fso.GetExtensionName(fsofile)) = "r-001-002.dwg" 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

GetExtensionName just returns the file extension, so it can never be "r-001-002.pdf", only "pdf"