VB and VBA Users Source Code: Reading document properties from a closed file or document
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Reading document properties from a closed file or document
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Sunday, July 08, 2001
Hits:
1669
Category:
Office
Article:
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 'Author : Andrew Baker 'Date : 08/Jul/2001 'Notes : Requires DSOFile.dll to be installed an registered. ' This can be downloaded from http://www.vbusers.com/downloads/Dsofile.exe. ' ' 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
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
