Excel VBA – PDF文件属性
第一次海报，但长期在本网站上findVBA和SQL解决scheme的粉丝。 我有一个VBA子程序，旨在查找用户指定的目录中的所有PDF文件。 该程序通过所有子文件夹进行recursion并生成电子表格，如下所示：
列A：完整的文件path（“C：\ Users \ Records \ NumberOne.pdf”）
B列：包含文件的文件夹path（“C：\ Users \ Records \”）
列C：文件名称本身（“NumberOne.pdf”）
到目前为止，程序（下面的代码）完美地工作。 我用它来search超过5万个PDF文件的目录，并且每次都成功地生成电子表格（程序总的运行时间通常在大型目录中是5-10分钟）。
问题是我想添加列D来捕获PDF文件的创builddate。 我已经search了这个，花了好几个小时，尝试像FSO.DateCreated等技术，没有任何工作。 如果FSO.DateCreated是我所需要的，我不知道在哪里插入它在我的子程序，使其工作。 通常我得到一个错误，该对象不支持该属性或方法。 是否有人碰巧知道我可以在哪里插入正确的代码来查找每个PDF创build的date并将其放到输出电子表格的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 你的代码是好的（除了缩进问题）。 我刚刚添加了从文件系统获取创builddate的说明，如下所示：
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”）
希望这有助于macros观大师
您需要使用GetFile获取文件，然后才能访问DateCreated 。
Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFile(myFileName) str = f.DateCreated MsgBox (str)
FileSystem.FileDateTime(inputfilepath)返回文件上次创build或修改时间的变体或date。