Visual Basic > Files Directories Drives

Reading document properties from a closed file or document

Reading document properties from a closed file or document

The following code demonstrates how to read document properties from a closed files(including office documents). Note, this function will also determine if an Office document contains a Macro using the "HASMACROS" property. This property can be used to write your own Macro Virus security dialog/code.

Option Explicit

'Purpose   :    Returns a document properties from a file
'Inputs    :    sFilePathName           The path and file name of the file to return the property from
'               sPropertyName           The name of the property to return
'Outputs   :    Returns the specified document property
'Notes     :    Requires DSOFile.dll to be installed an registered.
'
'               In VB could use CallByName instead of the large Select Case.
'               Must have exclusive access to the file. If another app has the 
'               file open, this function will not work.

Function DocumentPropertiesRead(sFilePathName As String, sPropertyName As String) As Variant
    Dim oFilePropReader As Object   'DSOleFile.PropertyReader
    Dim oDocProp As Object          'DSOleFile.DocumentProperties
    Dim lCustProp As Long, bCustomDocProp As Boolean
    
    On Error Resume Next
    Set oFilePropReader = CreateObject("DSOleFile.PropertyReader")
    
    If oFilePropReader Is Nothing Then
        MsgBox "This function requires the file DSOFile.dll to be installed"
    Else
        On Error GoTo ErrFailed
        If Len(sFilePathName) > 0 And Len(Dir$(sFilePathName)) > 0 Then
            'The file exists.
            Set oDocProp = oFilePropReader.GetDocumentProperties(sFilePathName)
            'Check custom document properties
            For lCustProp = 1 To oDocProp.CustomProperties.Count
                If UCase$(sPropertyName) = UCase$(oDocProp.CustomProperties(lCustProp).Name) Then
                    'Found property (in the Custom Doc. properties collection)
                    DocumentPropertiesRead = oDocProp.CustomProperties(lCustProp).Value
                    bCustomDocProp = True
                    Exit For
                End If
            Next
            
            If bCustomDocProp = False Then
                Select Case UCase$(sPropertyName)
                Case "APPNAME"
                    DocumentPropertiesRead = oDocProp.AppName
                Case "AUTHOR"
                    DocumentPropertiesRead = oDocProp.Author
                Case "BYTECOUNT"
                    DocumentPropertiesRead = oDocProp.ByteCount
                Case "CATEGORY"
                    DocumentPropertiesRead = oDocProp.Category
                Case "CHARACTERCOUNT"
                    DocumentPropertiesRead = oDocProp.CharacterCount
                Case "CLSID"
                    DocumentPropertiesRead = oDocProp.CLSID
                Case "COMMENTS"
                    DocumentPropertiesRead = oDocProp.Comments
                Case "COMPANY"
                    DocumentPropertiesRead = oDocProp.Company
                Case "DATELASTPRINTER"
                    DocumentPropertiesRead = oDocProp.DateLastPrinted
                Case "HASMACROS"
                    DocumentPropertiesRead = oDocProp.HasMacros
                Case "KEYWORDS"
                    DocumentPropertiesRead = oDocProp.Keywords
                Case "LASTEDITEDBY"
                    DocumentPropertiesRead = oDocProp.LastEditedBy
                Case "LOCATION"
                    DocumentPropertiesRead = oDocProp.Location
                Case "MANANGER"
                    DocumentPropertiesRead = oDocProp.Manager
                Case "PROGID"
                    DocumentPropertiesRead = oDocProp.ProgId
                Case "REVISIONNUMBER"
                    DocumentPropertiesRead = oDocProp.RevisionNumber
                Case "SUBJECT"
                    DocumentPropertiesRead = oDocProp.Subject
                Case "TITLE"
                    DocumentPropertiesRead = oDocProp.Title
                Case "VERSION"
                    DocumentPropertiesRead = oDocProp.Version
                Case Else
                    Debug.Print "Document property not found!!!"
                End Select
            End If
        End If
        
        Set oDocProp = Nothing
        Set oFilePropReader = Nothing
    End If
    
    Exit Function

ErrFailed:
    Debug.Print Err.Description
    On Error GoTo 0
End Function

'Demonstration routine
Sub Test()
    Debug.Print DocumentPropertiesRead("D:\shell.xls", "LASTEDITEDBY")
End Sub