Option Explicit

Dim i, Attribute, AttributeList

For i=0 To 100
    AttributeList = AttributeList & i & ")" & GetFileAttribute("C:\1.doc",i) & VbCrLf
Next

MsgBox AttributeList

Function GetFileAttribute(FileName,Attribute)
    Dim ShellApplication, Path, Name, Folder, FolderItem
    Set ShellApplication = CreateObject("Shell.Application")
    Path = Left(FileName, InStrRev(FileName, "\") - 1)
    Name = Mid(FileName,InStrRev(FileName, "\") + 1)
    Set Folder = ShellApplication.NameSpace(Path)
    Set FolderItem = Folder.ParseName(Name)
    GetFileAttribute = Folder.GetDetailsOf(FolderItem,Attribute)
End Function

Option Explicit

Dim i, OleDocumentProperties, AttributeList, AttributeValue

Set OleDocumentProperties = New clsOleDocumentProperties

OleDocumentProperties.OpenFile "C:\1.doc"

For i = 0 To 100
    AttributeValue = OleDocumentProperties.GetAttributeValue(i)
    If AttributeValue <> "" Then AttributeList = AttributeList & i & ")" & OleDocumentProperties.GetAttributeName(i) & ": " & AttributeValue & VbCrLf
Next

MsgBox AttributeList

Class clsOleDocumentProperties
    Private ShellApplication, Folder, FolderItem, Parsed
    Sub Class_Initialize
        Set ShellApplication = CreateObject("Shell.Application")
    End Sub
    
    Sub OpenFile(FileName)
        On Error Resume Next
        Parsed = False
        Dim Path, Name
        Path = Left(FileName, InStrRev(FileName, "\") - 1)
        Name = Mid(FileName,InStrRev(FileName, "\") + 1)
        Set Folder = ShellApplication.NameSpace(Path)
        Set FolderItem = Folder.ParseName(Name)
        if Err.number <> 0 or FolderItem is Nothing Then 
            On Error Goto 0
            Err.Raise vbObjectError + 1,"OpenFile","Не удалось открыть файл """ & FileName & """"
        End if
        Parsed = True
    End Sub

    Function GetAttributeValue(index)
        if Parsed Then GetAttributeValue = Folder.GetDetailsOf(FolderItem,index)
    End Function

    Function GetAttributeName(index)
        if Parsed Then GetAttributeName = Folder.GetDetailsOf(,index)
    End Function
End Class