[英]How to populate last saved user and last saved date of a file
我有下面的代码可以从文件夹中获取文件名。
Sub GetFileNames_Assessed_As_T2()
Dim sPath As String, sFile As String
Dim iRow As Long, iCol As Long
Dim ws As Worksheet: Set ws = Sheet9
'declare and set the worksheet you are working with, amend as required
sPath = "Z:\NAME\T2\"
'specify directory to use - must end in ""
sFile = Dir(sPath)
Do While sFile <> ""
LastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row 'get last row on Column I
Filename = Left(sFile, InStrRev(sFile, ".") - 1) 'remove extension from file
Set FoundFile = ws.Range("I1:I" & LastRow).Find(what:=Filename, lookat:=xlWhole) 'search for existing filename
If FoundFile Is Nothing Then ws.Cells(LastRow + 1, "I") = Filename 'if not found then add it
sFile = Dir ' Get next filename
Loop
End Sub
我需要进行调整以获取以下内容并将其填充到电子表格中:
下面是通过 Dsofile.dll 访问扩展文档属性的示例。 32 位版本在这里。 我正在使用robert8w8重写的 64 位替代方案。 安装后,在我的情况下是 64 位版本,您转到 Tools > References >Add a reference to DSO OLE Document Properties Reader 2.1
。 它可以访问关闭文件的扩展属性。 显然,如果信息不可用,则无法返回。
我在那里有一个可选的文件掩码测试,可以删除。
DSO 函数是我重新编写的一个很棒的子程序,它在此处列出了 xld 的更多属性。
Option Explicit
Public Sub GetLastestDateFile()
Dim FileSys As Object, objFile As Object, myFolder As Object
Const myDir As String = "C:\Users\User\Desktop\TestFolder" '< Pass in your folder path
Set FileSys = CreateObject("Scripting.FileSystemObject")
Set myFolder = FileSys.GetFolder(myDir)
Dim fileName As String, lastRow As Long, arr(), counter As Long
With ThisWorkbook.Worksheets("Sheet1") '<== Change to your sheet where writing info to
lastRow = .Cells(.Rows.Count, "P").End(xlUp).Row 'find the last row with data in P
For Each objFile In myFolder.Files 'loop files in folder
fileName = objFile.Path
If FileSys.GetExtensionName(fileName) = "xlsx" Then 'check if .xlsx
arr = GetExtendedProperties(fileName)
counter = counter + 1
.Cells(lastRow + counter, "O") = arr(0) 'Last updated
.Cells(lastRow + counter, "P") = arr(1) 'Last save date
.Hyperlinks.Add Anchor:=.Cells(lastRow + counter, "Q"), Address:=objFile.Path '<== Add hyperlink
End If
Next objFile
End With
End Sub
Public Function GetExtendedProperties(ByVal FileName As String) As Variant
Dim fOpenReadOnly As Boolean, DSO As DSOFile.OleDocumentProperties
Dim oSummProps As DSOFile.SummaryProperties, oCustProp As DSOFile.CustomProperty
Dim outputArr(0 To 1)
Set DSO = New DSOFile.OleDocumentProperties
DSO.Open FileName, fOpenReadOnly, dsoOptionOpenReadOnlyIfNoWriteAccess
Set oSummProps = DSO.SummaryProperties
outputArr(0) = oSummProps.LastSavedBy
outputArr(1) = oSummProps.DateLastSaved
GetExtendedProperties = outputArr
End Function
其他:
在我的情况下,我无法使用 dsofile.dll 中的 DSO 库(需要管理员才能安装并注册它...),所以我想出了另一种解决方案来获取 Office 文档的一些 OLE 属性而无需打开它们。 似乎(一些?)这些扩展属性也可以通过外壳访问:
Function GetDateLastSaved_Shell32(strFileFullPath$)
strFolderPath$ = Left(strFileFullPath, Len(strFileFullPath) - Len(Dir(strFileFullPath)))
strFileName$ = Dir(strFileFullPath)
'using late binding here
'to use early binding with Dim statements you need to reference the Microsoft Shell Controls And Automation library, usually available here:
'C:\Windows\SysWOW64\shell32.dll
'Example:
'Dim shlShell As Shell32.Shell
Set shlShell = CreateObject("Shell.Application") 'Variant/Object/IShellDispatch6
'Set shlFolder = shlShell.Namespace(strFolderPath) 'does not work when using late binding, weird...*
Set shlFolder = shlShell.Namespace(CStr(strFolderPath)) 'works...
'Set shlFolder = shlShell.Namespace(strFolderPath & "") 'works...
'Set shlFolder = shlShell.Namespace(Left$(strFolderPath, Len(strFolderPath))) 'works...
'*also mentioned here without an explanation...
'https://stackoverflow.com/questions/35957930/word-vba-shell-object-late-binding
Set shlShellFolderItem = shlFolder.ParseName(strFileName)
'all of the following returns the same thing (you have the returned Data Type indicated on the right)
'but the first one is said by MSDN to be the more efficient way to get an extended property
GetDateLastSaved_Shell32 = shlShellFolderItem.ExtendedProperty("{F29F85E0-4FF9-1068-AB91-08002B27B3D9} 13") 'Date
'GetDateLastSaved_Shell32 = shlShellFolderItem.ExtendedProperty("System.Document.DateSaved") 'Date
'GetDateLastSaved_Shell32 = shlShellFolderItem.ExtendedProperty("DocLastSavedTm") 'Date 'legacy name
'GetDateLastSaved_Shell32 = shlFolder.GetDetailsOf(shlShellFolderItem, 154) '?String?
End Function
要列出所有扩展属性(核心、文档等),您可以使用:
For i = 0 To 400
vPropName = shlFolder.GetDetailsOf(Null, i)
vprop = shlFolder.GetDetailsOf(shlShellFolderItem, i)
Debug.Print i, vPropName, vprop
If i Mod 10 = 0 Then Stop
Next
您可以在 MSDN 上找到有关“有效方式”的更多信息: ShellFolderItem.ExtendedProperty 方法
您还可以在 Windows SDK 的 propkey.h 或
C:\\Program Files (x86)\\Windows Kits\\10\\Include\\***VERSION***\\um\\\u003c/code>工作室安装。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.