Windows 10 Retrieving Extended File Properties

Sub GetFileAttributes()
    '(May 2018: updated to improve efficiency)
    'Requires reference: "Microsoft Shell Controls and Automation" (shell332.dll)
    Const strFilePath = "c:\MP3's\Beastie Boys - Intergalactic.mp3"
    
    Dim objShell As Shell, objFolder As Folder, objFolderItem As FolderItem
    Dim props As Object, i As Long, strPath As String, strFile As String
    
    strFile = Mid(strFilePath, InStrRev(strFilePath, "\") + 1) 'extract filename
    strPath = Left(strFilePath, Len(strFilePath) - Len(strFile) - 1) 'extract path
    
    Set objShell = New Shell
    Set objFolder = objShell.NameSpace(strPath) 'create folder object
    Set objFolderItem = objFolder.ParseName(strFile) 'create file object
    Set props = CreateObject("Scripting.Dictionary") 'create dictionary object

    For i = 0 To 286 'put properties in dictionary object for eacy retrieval later
        props.Add objFolder.GetDetailsOf(objFolder.Items, i), objFolder.GetDetailsOf(objFolderItem, i)
    Next i

    'dictionary is populated. Now list properties that have values
    Dim key As Variant
    For Each key In props.Keys 'enumerate dictionary
        If props(key) <> "" Then Debug.Print key & ": " & props(key)
    Next key
    'or, return specific property:  If props.Exists("Category") Then Debug.Print props("Category")
    
    props.RemoveAll ' clean up
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
End Sub

'This requires the reference: Microsoft Shell Controls and Automation

Sub GetFileAttributes()

'enter the full path to the file
   ' Const strFilePath = "G:\Programs\MendipDataSystems\CommonFiles\SDA\Icons\SDA_DEMO.ico"
   ' Const strFilePath = "G:\Programs\MendipDataSystems\CommonFiles\SDA\Images\AccessErrorCodes.gif"
   ' Const strFilePath = "G:\Programs\MendipDataSystems\CommonFiles\SDA\Documentation\AnalyseSessionReportGrades.pdf"
    Const strFilePath = "D:\Colin\My Documents\My Music\Leonard Cohen\You Want It Darker\04 Leaving The Table.mp3"
    
    Dim objShell As Shell32.Shell
    Dim objFolder As Shell32.Folder
    Dim objFolderItem As Shell32.FolderItem
    Dim strPath As String, strFileName As String
    Dim aName As String, aValue As String
    Dim I As Integer
    Dim tComments As String, tCategory As String, tTitle As String
    
    I = 1
    strFileName = strFilePath
    Do Until I = 0 'find the last "\" and get the filename
        I = InStr(1, strFileName, "\", vbBinaryCompare)
        strFileName = Mid(strFileName, I + 1)
    Loop
    strPath = Left(strFilePath, Len(strFilePath) - Len(strFileName) - 1)
    Set objShell = New Shell
    Set objFolder = objShell.NameSpace(strPath)
    Set objFolderItem = objFolder.ParseName(strFileName)
        
    For I = 0 To 255
        aName = objFolder.GetDetailsOf(objFolder.Items, I)
        aValue = objFolder.GetDetailsOf(objFolderItem, I)
        
        'list attributes available in this folder:
        If Nz(objFolder.GetDetailsOf(objFolderItem, I), "") <> "" Then
            Debug.Print I & " - " & objFolder.GetDetailsOf(objFolder.Items, I) & ": " & _
                  objFolder.GetDetailsOf(objFolderItem, I)
        End If
        
    Next I
    
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
     

End Sub

Public Sub GetFileAttributes(strFilePath As String)

Dim strProc As String, I as Integer

strProc = "GetFileAttributes"

'This requires the reference: Microsoft Shell Controls and Automation
   
 On Error GoTo Err_Handler
    
    I = 1
    strFileName = strFilePath
    Do Until I = 0 'find the last "\" and get the filename
        I = InStr(1, strFileName, "\", vbBinaryCompare)
        strFileName = Mid(strFileName, I + 1)
    Loop
    
    strPath = Left(strFilePath, Len(strFilePath) - Len(strFileName) - 1)
    
    Set objShell = New Shell
    Set objFolder = objShell.NameSpace(strPath)
    Set objFolderItem = objFolder.ParseName(strFileName)
        
    For I = 0 To 320
        aName = objFolder.GetDetailsOf(objFolder.Items, I)
        aValue = objFolder.GetDetailsOf(objFolderItem, I)
       
       'full list of available attributes (depending on file type)
       Debug.Print I & " - " & objFolder.GetDetailsOf(objFolder.Items, I)
        
        'list attributes available in this folder:
        If Nz(objFolder.GetDetailsOf(objFolderItem, I), "") <> "" Then
            Debug.Print I & " - " & objFolder.GetDetailsOf(objFolder.Items, I) & ": " & _
                  objFolder.GetDetailsOf(objFolderItem, I)
        End If        
   
    Next I
    
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
        
   
Exit_Handler:
    Exit Sub
    
Err_Handler:
    MsgBox "Error " & Err.Number & " in " & strProc & " procedure: " & Err.Description
    GoTo Exit_Handler

End Sub

strFilePath = "G:\Programs\MendipDataSystems\CommonFiles\SDA\Images\AccessErrorCodes.gif"
GetFileAttributes strFileName