Modules: Read Word Document Properties (Author, Last Print Date etc.)

(Q)    How do I read various properties of a Word Document, such as Last Print Date, Author Name, Title etc.?

(A)    There are two ways to get to Office document properties, one way is to simply automate the host app (as shown below) and read off the properties; and the other way is to use the DSOFile.DLL provided by Microsoft PSS in the following Knowledge Base article (using the COM dll will provide more flexibility):

Article ID: 224351 DSOFILE.EXE Lets You Read Document Properties Without Office Installed

You can also use the function fEnumProps to enumerate all properties of a document.  Use fGetDocProps to return a property's value.

'************ Code Start **********
'This code was originally written by Dev Ashish
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Function fGetDocProps(strInFile As String, strProp As String)
'Usage Examples (pass one of the properties returned by fEnumProps
'Return Number of Chars:
'   ?fGetDocProps("C:\more junk\read me.doc","Number of Characters")
'Return Last Print Date:
'   ?fGetDocProps("C:\more junk\read me.doc","Last Print Date")
'
Dim objWord As Object, objDocProps As Object
    
    On Error GoTo Err_fGetDocProps
    Set objWord = CreateObject("Word.Application")
    objWord.Documents.Open strInFile
    Set objDocProps = objWord.ActiveDocument.BuiltInDocumentProperties
    fGetDocProps = objDocProps(strProp)
    
Exit_fGetDocProps:
    objWord.Application.Quit savechanges:=False
    Set objDocProps = Nothing
    Set objWord = Nothing
    Exit Function

Err_fGetDocProps:
    fGetDocProps = "Error: Probably File/Property does not exist."
    Resume Exit_fGetDocProps
End Function

Function fEnumProps(strInFile As String)
'Usage Examples
'?fEnumProps("C:\more junk\read me.doc")
'
Dim objWord As Object, objDocProps As Object
Dim i As Integer
    On Error Resume Next
    Set objWord = CreateObject("Word.Application")
    With objWord
        .Documents.Open strInFile
        Set objDocProps = objWord.ActiveDocument.BuiltInDocumentProperties
        For i = 0 To objDocProps.Count - 1
            Debug.Print objDocProps(i).Name, objDocProps(i).value
        Next i
    End With
    objWord.Application.Quit savechanges:=False
    Set objWord = Nothing
End Function
'************ Code End **********