在各个文件夹中搜索最新保存的PDF文件并将最新的文件复制到特定位置

Question

我需要一个VBA Excel宏来查找文件夹和子文件夹中最新保存的PDF文件以获取最新的（创建日期和时间），然后需要复制到特定位置。

下面的代码仅适用于主文件夹，不适用于子文件夹。此外，文件是从源路径复制的，但没有粘贴到目标路径中。

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

Answer 1

您需要首先浏览主文件夹，然后循环浏览子文件夹。另外，请记住，

datelastmodified

和

datecreated

之间存在差异，因此请明智选择。

Sub copy_files_from_subfolders()
    Dim fso As Object
    Dim fld As Object
    Dim fsofile As Object
    Dim fsofol As Object
    Dim CurrentFileDate As Date
    Dim LatestDate As Date

    SourcePath = "C:\SourcePath\"
    DestinationPath = "C:\DestinationPath\"

    Set fso = CreateObject("scripting.filesystemobject")
    Set fld = fso.GetFolder(SourcePath)
    If fso.FolderExists(fld) Then
        ' so first check the main path
        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
        
        'Now the subfolders
        For Each fsofol In fso.GetFolder(SourcePath).SubFolders
            For Each fsofile In fsofol.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
        Next
    End If
    
    If LatestFile <> "" Then
        fso.CopyFile LatestFile, DestinationPath & fso.GetFileName(LatestFile)
    Else
        MsgBox "No PDF files.", vbExclamation
    End If
End Sub