How to populate last saved user and last saved date of a file

Question

I have the code below to get file names from folders.

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

I need an adjustment to fetch the following and populate it on the spreadsheet:

• File last updated by (Column O)
• File last updated date (Column P)
• Hyperlink the file to the spreadsheet (Column Q)

Answer 1

Here is an example accessing the extended document properties via Dsofile.dll. 32 bit version is here. I am using re-written 64 bit alternative by robert8w8. After installation, of 64 bit version in my case, you go Tools >References >Add a reference to DSO OLE Document Properties Reader 2.1. It enables to access extended properties of closed files. Obviously, if the info is not available, it cannot be returned.

I have an optional filemask test in there which can be removed.

The DSO function is my re-write of a great sub that lists many more properties by xld here.

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

---

Other:

1. Hyperlinks.Add method

Answer 2

In my case I could not use the DSO library from dsofile.dll (one needs to be admin to install it and register it...), so I came up with another solution to get some OLE properties of Office documents without opening them. It appears that (some of?) these Extended Properties are also accessible via the 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

To list all extended properties (Core, Documents, etc.), you can use this:

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

You can find more info about the "efficient way" on MSDN: ShellFolderItem.ExtendedProperty method

You can also find the list of FMTIDs and PIDSIs in propkey.h from Windows SDK or somewhere in C:\Program Files (x86)\Windows Kits\10\Include\***VERSION***\um\ if you have Visual Studio installed.