Excel VBA - PDF 文件属性
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18660818/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA - PDF file properties
提问by Angler
first-time poster but long-time fan for finding VBA and SQL solutions on this site. I have a VBA subroutine that is designed to find all PDF files within a directory that the user designates. The program does recursions through all subfolders and generates a spreadsheet as follows:
第一次发帖，但长期支持在此站点上查找 VBA 和 SQL 解决方案。我有一个 VBA 子程序，用于在用户指定的目录中查找所有 PDF 文件。该程序通过所有子文件夹进行递归并生成如下电子表格：
Column A: complete file path ("C:\Users\Records\NumberOne.pdf")
A 列：完整的文件路径（“C:\Users\Records\NumberOne.pdf”）
Column B: folder path containing the file ("C:\Users\Records\")
B 列：包含文件的文件夹路径（“C:\Users\Records\”）
Column C: the file name itself ("NumberOne.pdf")
C列：文件名本身（“NumberOne.pdf”）
Up to this point, the program (code below) works flawlessly. I've used it to search a directory with over 50,000 PDF files, and it successfully generates the spreadsheet every time (total elapsed time for the program is usually 5-10 minutes in large directories).
到目前为止，该程序（下面的代码）可以完美运行。我用它来搜索一个包含超过 50,000 个 PDF 文件的目录，并且每次都能成功生成电子表格（程序在大目录中的总运行时间通常为 5-10 分钟）。
The problem is that I want to add Column D to capture the date that the PDF file was created. I have Googled this and labored over it for hours, trying techniques like FSO.DateCreated and so forth, and nothing has worked. If FSO.DateCreated is what I need, I'm not sure where to insert it in my subroutine to make it work. Usually I get an error that the object does not support that property or method. Does anybody happen to know where I can insert the proper code for my program to find the date each PDF was created and drop it into Column D on my output spreadsheet?
问题是我想添加 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
采纳答案by TheMacroGuru
Your code is fine (beside some issues with indentation). I just added the instruction to get the creation date from the file system, as you can see below:
您的代码很好（除了一些缩进问题）。我刚刚添加了从文件系统获取创建日期的指令，如下所示：
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
I don't know why you weren't able to use the FSO object, but I believe it can be because few lines below you set it to nothing, so I instantiated it again before the first For cycle:
我不知道你为什么不能使用 FSO 对象，但我相信这可能是因为下面几行你将它设置为空，所以我在第一个 For 循环之前再次实例化它：
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSO = CreateObject("Scripting.FileSystemObject")
Hope this helps, The Macro Guru
希望这会有所帮助，宏观大师
回答by Stewbob
You need to get the file with GetFilebefore you can access the DateCreated.
您需要先获取文件，GetFile然后才能访问DateCreated.
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(myFileName)
str = f.DateCreated
MsgBox (str)
回答by Aaron Thomas
FileSystem.FileDateTime(inputfilepath)returns a variant or date of when the file was last created or modified.
FileSystem.FileDateTime(inputfilepath)返回上次创建或修改文件的变体或日期。
