Question

第一次发布海报，但在本网站上寻找VBA和SQL解决方案的长期粉丝。我有一个VBA子例程，旨在查找用户指定的目录中的所有PDF文件。该程序通过所有子文件夹进行递归，并生成如下的电子表格：

A栏：完整的档案路径（“C：\ Users \ Records \ NumberOne.pdf”）

B列：包含文件的文件夹路径（“C：\ Users \ Records \”）

C栏：文件名本身（“NumberOne.pdf”）

到目前为止，程序（下面的代码）完美无瑕。我用它来搜索超过50,000个PDF文件的目录，并且每次都成功生成电子表格（在大型目录中，程序的总耗用时间通常为5-10分钟）。

问题是我想添加D列来捕获PDF文件的创建日期。我用谷歌搜索了这个并且花了好几个小时，尝试了像FSO.DateCreated这样的技术，等等，没有任何效果。如果FSO.DateCreated是我需要的，我不知道在我的子程序中将它插入到哪里以使其工作。通常我得到一个错误，该对象不支持该属性或方法。有没有人碰巧知道在哪里可以为我的程序插入正确的代码来查找每个PDF的创建日期并将其放到输出电子表格的D列中？

Sub GetFiles()
'-- RUNS AN UNLIMITED RECURSION SEARCH THROUGH A TARGETED FOLDER AND FINDS ALL PDF FILES WITHIN

        Application.ScreenUpdating = False
        Application.DisplayAlerts = False

        Dim j As Long
        Dim ThisEntry As String
        Dim strDir As String
        Dim FSO As Object
        Dim strFolder As String
        Dim strName As String
        Dim DateCreated As Date '--(Possibly String?)
        Dim strArr(1 To 1048576, 1 To 1) As String, i As Long
        Dim fldr As FileDialog

        '-- OPEN DIALOG BOX TO SELECT DIRECTORY THE USER WISHES TO SEARCH
        Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
        With fldr
            .Title = "Select the directory you wish to search"
            .AllowMultiSelect = False
            If .Show <> -1 Then
                Exit Sub
                Set fldr = Nothing
            Else
                strDir = .SelectedItems(1) & "\"
            End If
        End With

        '-- LOOK FOR RECORDS WORKSHEET; IF IT DOES NOT EXIST, CREATE IT; IF IT DOES EXIST, CLEAR CONTENTS
        If Not (wsExists("records")) Then
                Worksheets.Add
            With ActiveSheet
                .Name = "records"
            End With
            Set ws = ActiveSheet
        Else
            Sheets("records").Activate
            Range("A1:IV1").EntireColumn.Delete
            Set ws = ActiveSheet
        End If

        '-- SET SEARCH PARAMETERS
        Let strName = Dir$(strDir & "\" & "*.pdf")
        Do While strName <> vbNullString
            Let i = i + 1
            Let strArr(i, 1) = strDir & strName
            Let strName = Dir$()
        Loop

        '-- UNLIMITED RECURSIONS THROUGH SUBFOLDERS
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Call recurseSubFolders(FSO.GetFolder(strDir), strArr(), i)
        Set FSO = Nothing

        '-- CREATE COLUMN HEADERS ON OUTPUT WORKSHEET
        With ws
            Range("A1").Value = "AbsolutePath"
            Range("B1").Value = "FolderPath"
            Range("C1").Value = "FileName"
            Range("D1").Value = "DateCreated"
        End With

        If i > 0 Then
            ws.Range("A2").Resize(i).Value = strArr
        End If

        lr = Cells(Rows.Count, 1).End(xlUp).Row

        For i = 1 To lr
        ThisEntry = Cells(i, 1)

        '-- EXTRACT FOLDER PATH AND FILE NAME FROM STRING
        For j = Len(ThisEntry) To 1 Step -1
            If Mid(ThisEntry, j, 1) = Application.PathSeparator Then
            Cells(i, 2) = Left(ThisEntry, j)
            Cells(i, 3) = Mid(ThisEntry, j + 1)
        Exit For

        End If
        Next j
        Next i

        Application.ScreenUpdating = True
        Application.DisplayAlerts = True

End Sub

----------

Private Sub recurseSubFolders(ByRef Folder As Object, _
ByRef strArr() As String, _
ByRef i As Long)
Dim SubFolder As Object
Dim strName As String

        For Each SubFolder In Folder.SubFolders
        Let strName = Dir$(SubFolder.Path & "\" & "*.pdf")
        Do While strName <> vbNullString
        Let i = i + 1
        Let strArr(i, 1) = SubFolder.Path & "\" & strName
        Let strName = Dir$()
        Loop
        Call recurseSubFolders(SubFolder, strArr(), i)
        Next

End Sub

Answer 1

您必须先使用GetFile获取该文件，然后才能访问DateCreated。

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(myFileName)
str = f.DateCreated
MsgBox (str)

Answer 2

您的代码很好（除了缩进的一些问题）。我刚刚添加了从文件系统获取创建日期的指令，如下所示：

Set FSO = CreateObject("Scripting.FileSystemObject")
For i = 1 To lr
    ThisEntry = Cells(i, 1)

'-- EXTRACT FOLDER PATH AND FILE NAME FROM STRING
    For j = Len(ThisEntry) To 1 Step -1
        If Mid(ThisEntry, j, 1) = Application.PathSeparator Then
            Cells(i, 2) = Left(ThisEntry, j)
            Cells(i, 3) = Mid(ThisEntry, j + 1)
            Cells(i, 4) = FSO.GetFile(ThisEntry).DateCreated
            Exit For

        End If
    Next j
Next i

我不知道为什么你不能使用FSO对象，但我相信它可能是因为你下面几行没有设置它，所以我在第一个For循环之前再次实例化它：

设置FSO = CreateObject（“Scripting.FileSystemObject”）

希望这有帮助，宏观大师

Answer 3

FileSystem.FileDateTime(inputfilepath)返回上次创建或修改文件的变体或日期。

Excel VBA - PDF文件属性

3 个答案: