VBA填充文件的上次保存用户和上次保存日期

我一直在使用下面的代码从文件夹中获取文件名，这非常有效，但我需要做一些小的调整。我需要加载项获取以下内容并将其填充到电子表格中：

• 文件上次更新人（第O列）
• 文件上次更新日期（第P列）
• 将文件超链接到电子表格（Q列）

有人能帮我更新这个代码来包含这些吗

代码：

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

子GetFileNames\u评估为\u T2（）
尺寸sPath为字符串，sFile为字符串
暗淡的iRow和长的一样，iCol和长的一样
将ws设置为工作表：设置ws=Sheet9
'声明并设置正在使用的工作表，根据需要进行修改
sPath=“Z:\NAME\T2\”
'指定要使用的目录-必须以“”结尾
sFile=Dir（sPath）
在sFile“”时执行此操作
LastRow=ws.Cells（ws.Rows.Count，“I”）.End（xlUp）.Row'获取列I上的最后一行
Filename=Left（sFile，InStrRev（sFile，“.”-1）”从文件中删除扩展名
设置FoundFile=ws.Range（“I1:I”&LastRow）.Find（what:=Filename，lookat:=xlother）搜索现有文件名
如果FoundFile为Nothing，则ws.Cells（LastRow+1，“I”）=Filename'如果未找到，则添加它
sFile=Dir'获取下一个文件名
环
端接头

以下是通过Dsofile.dll访问扩展文档属性的示例。32位版本是。我使用的是由重新编写的64位备选方案。在安装64位版本（在我的例子中）后，您可以转到工具>参考>添加对

DSO OLE Document Properties Reader 2.1

的参考。它允许访问已关闭文件的扩展属性。显然，如果信息不可用，则无法返回

我有一个可选的文件掩码测试，可以删除

DSO函数是我重新编写的一个很棒的子函数，它通过xld列出了更多的属性

选项显式
公共子GetLastTestDateFile（）
Dim FileSys作为对象，objFile作为对象，myFolder作为对象
Const myDir As String=“C:\Users\User\Desktop\TestFolder”<在文件夹路径中传递
设置FileSys=CreateObject（“Scripting.FileSystemObject”）
设置myFolder=FileSys.GetFolder（myDir）
Dim文件名为字符串，lastRow为长，arr（）为长，计数器为长
对于ThisWorkbook.Worksheets（“Sheet1”）”在我的例子中，我无法使用dsofile.dll中的DSO库（需要管理员才能安装并注册它…），因此我想出了另一种解决方案，可以在不打开Office文档的情况下获取其某些OLE属性。看起来（其中一些？）这些扩展属性也可以通过Shell访问：

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上找到有关“高效方式”的更多信息：

您还可以在Windows SDK的propkey.h中或
C:\Program Files（x86）中的某处找到FMTID和PIDSI的列表\如果您安装了Visual Studio，Windows工具包\10\包括\***版本***\um \
。
可能是@nicomp的副本我不认为有人可以录制一个宏，用文件的上次修改日期填充单元格，并按值创建。@jnevil您说得对。我敢打赌我们一定能找到。但是我在网上搜索了30秒后发现了这个VBA：公共函数ModDate（）ModDate=Format（FileDateTime（thishworkbook.FullName），“m/d/yy h:n ampm”）结束函数谢谢大家的评论。@nicomp my VBA并不令人惊讶，因此您能否分享我将如何以及在何处将其添加到代码中，以使其填充到正确的位置？为了正确理解这一点，请下载Active X程序以获取其他文件信息，然后更新并运行上面的代码？如果这是帮助更新的情况，我可以要求您在代码中添加注释以允许我进行编辑吗？谢谢，我已经下载了此内容，但我有点困惑如何将其添加到我当前的代码中，您能帮我吗？我更新了信息，在第10行我得到了“下标超出范围”我的信息填充在I列中，因此我更新到Imy抱歉我意识到我的错误，新错误我在脚本第二部分的这一行中得到“用户定义类型未定义”：Dim fOpenReadOnly作为布尔值，DSO作为DSOFile.oledDocumentProperties我真是感激不尽！！它工作得很好！我先运行了我的代码，然后运行了你的代码（在来回运行了一段时间后），但它是有效的！还有一件事吗？如果我想在这一行中添加多个文档类型：if FileSys.GetExtensionName（FileName）=“docx”，那么“检查if.docx我是否只需要像“docx，PDF”等那样添加它们。这样做是否必须有所不同？
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