Sleeper: Is there a faster method to find extended file properties

[Paul_Hossler]

Since the file properties change from OS version to OS version, you need to take the property (e.g. "Attributes") and get the field number (e.g. 6) (faGetFieldNumber) first and look it up by that

Option Explicit


Sub drv()
    MsgBox faGetFileProperty("C:\Users\Daddy\Desktop\Fonts.xlsm", "Attributes")
End Sub




Function faGetFileProperty(sFilename As String, sProperty As String) As Variant
    Dim iProp As Long
    Dim oFolder As Object, oFolderItem As Object
    Dim iFieldNumber As Long
    Dim sFolder As String, sFile As String
    
    faGetFileProperty = vbNullString


    On Error GoTo NiceExit
    iProp = faGetFieldNumber(sProperty)
    
    If iProp = -1 Then Exit Function


    With CreateObject("scripting.FileSystemObject")
        sFolder = .GetParentFolderName(sFilename)
        sFile = .GetFileName(sFilename)
    End With
    
    Set oFolder = CreateObject("shell.application").Namespace(sFolder & "\")
    Set oFolderItem = oFolder.ParseName(sFile)
    
    faGetFileProperty = oFolder.GetDetailsOf(oFolderItem, iProp)


NiceExit:


End Function


Function faGetFieldNumber(s) As Long
    Dim oFolder As Object
    Dim n As Long
    Dim sDesktop As Variant
    
    sDesktop = CreateObject("wscript.shell").specialfolders(10) & Application.PathSeparator
    Set oFolder = CreateObject("shell.application").Namespace(sDesktop)
    
    On Error GoTo Oops
    
         For n = 0 To 999
        If LCase(s) = LCase(oFolder.GetDetailsOf(oFolder.items, n)) Then
            faGetFieldNumber = n
            Exit Function
        End If
    Next n


Oops:
    Set oFolder = Nothing
    faGetFieldNumber = -1
     
End Function