Listing used Word Document Properties


Introduction

In my Working with Word ebook (the 4th edition is available now), there is code that lists (among other things) the document properties in a Word document.  This is useful information, but sometimes you need to know which of the doc properties have actually been used; that is what the code in the sample database for this article does.

The Form

The sample database, Listing Used Doc Props (AA 245).accdb, has only one form, a simple menu:

AW 1710-A

Figure A. The main menu of the sample database

There is a button for listing the used doc properties, either in a single document or a folder. If you select the Folder option, the folder selector button is enabled so you can select the folder containing the documents to process.

VBA Code

Clicking the List Used Doc Properties button runs one of the procedures listed below:

1
Public Sub GetUsedDocPropsForDocument()

 

1
On Error GoTo ErrorHandler

 

1
strTable = "tblDocPropFields"
1
strSQL = "DELETE * FROM " & strTable
1
CurrentDb.Execute strSQL
1
<strong><em>   'Select file, using an Office FileDialog FilePicker dialog</em></strong>
1
strFileNameAndPath = SelectFile
1
Set appWord = GetObject(, "Word.Application")
1
appWord.Visible = True
1
Set doc = appWord.Documents.Open(strFileNameAndPath)
1
strDoc = doc.Name
1
strDoc = Mid(strDoc, 1, InStrRev(strDoc, ".") - 1)
1
strDocsPath = GetProperty("WordDocsPath", "")
1
strTextFile = strDocsPath &amp; "\Doc property fields in " _
1
&amp; strDoc &amp; ".txt"
1
Debug.Print "Text file: " &amp; strTextFile

 

1
Set rst = CurrentDb.OpenRecordset(strTable)

 

1
<strong><em>   'Open text file in same folder as document</em></strong>
1
Set ts = fso.OpenTextFile(FileName:=strTextFile, _
1
IOMode:=ForWriting, _
1
Create:=True)
1
ts.WriteBlankLines 1
1
ts.WriteLine "Document Property Fields in " &amp; strDoc
1
ts.WriteLine "--------------------------------------------------"
1
ts.WriteBlankLines 1

 

1
For Each wfld In doc.Fields
1
If wfld.Type = wdFieldDocProperty Then
1
strCode = wfld.Code

 

1
<strong><em>         'Clean up doc prop name as needed</em></strong>
1
If Mid(strCode, 13) = Chr(34) Then
1
strDPName = Mid(strCode, 14)
1
Else
1
strDPName = Mid(strCode, 13)
1
End If

 

1
intPos = Nz(InStr(strDPName, ""))

 

1
If intPos &gt; 0 Then
1
strDPName = Left(strDPName, intPos - 1)
1
End If

 

1
strDPName = Replace(strDPName, Chr(34), "")
1
strDPName = Replace(strDPName, Chr(32), "")
1
Debug.Print strDPName

 

1
<strong><em>         'Add doc prop name to table</em></strong>
1
rst.AddNew
1
rst![DocumentName] = doc.Name
1
rst![DocPropertyFieldName] = strDPName
1
rst.Update

 

1
<strong><em>         'Write line with doc prop name to text file</em></strong>
1
ts.WriteLine strDPName
1
End If
1
Next wfld

 

1
rst.Close
1
ts.Close

 

1
<strong><em>   'Open text file</em></strong>
1
Call Shell(PathName:="Notepad.exe " &amp; strTextFile, _
1
windowstyle:=vbNormalFocus)

 

1
ErrorHandlerExit:
1
Set rst = Nothing
1
Set fso = Nothing
1
Set ts = Nothing
1
Exit Sub

 

1
ErrorHandler:
1
If Err.Number = 5792 Then
1
strTitle = "File problem"
1
strPrompt = strDoc &amp; " is corrupted; can't process it"
1
MsgBox prompt:=strPrompt, _
1
buttons:=vbInformation + vbOKOnly, _
1
Title:=strTitle
1
GoTo ErrorHandlerExit
1
ElseIf Err = 429 Then
1
<strong><em>      'Word is not running; open Word with CreateObject</em></strong>
1
Set appWord = CreateObject("Word.Application")
1
Resume Next
1
Else
1
MsgBox "Error No: " &amp; Err.Number _
1
&amp; " in GetUsedDocPropsForDocument procedure; " _
1
&amp; "Description: " &amp; Err.Description
1
Resume ErrorHandlerExit
1
End If

 

1
End Sub

 

1
Public Sub GetUsedDocPropsForFolder()

 

1
On Error GoTo ErrorHandler

 

1
strTable = "tblDocPropFields"
1
strSQL = "DELETE * FROM " &amp; strTable
1
CurrentDb.Execute strSQL

 

1
Set appWord = GetObject(, "Word.Application")
1
appWord.Visible = False

 

1
strDocsPath = GetProperty("WordDocsPath", "")

 

1
<strong><em>   'Get folder of documents to process from custom database property</em></strong>
1
Set fld = fso.GetFolder(strDocsPath)

 

1
For Each fil In fld.Files
1
If (Right(fil.Name, 3) = "doc" Or Right(fil.Name, 4) = "docx" _
1
Or Right(fil.Name, 3) = "dot" Or Right(fil.Name, 4) = "dotx") _
1
And (Left(fil.Name, 1) &lt;&gt; "~" _
1
And Nz(InStr(fil.Name, "Copy")) = 0) Then
1
strFileNameAndPath = strDocsPath &amp; "" &amp; fil.Name
1
Debug.Print "File to process: " &amp; strFileNameAndPath
1
Set doc = appWord.Documents.Open(strFileNameAndPath)
1
strDoc = doc.Name
1
strDoc = Mid(strDoc, 1, InStrRev(strDoc, ".") - 1)
1
strTextFile = strDocsPath &amp; "\Doc property fields in " _
1
&amp; strDoc &amp; ".txt"
1
'Debug.Print "Text file: " &amp; strTextFile

 

1
Set rst = CurrentDb.OpenRecordset(strTable)
1
<strong><em>         'Open text file in same folder as documents</em></strong>
1
Set ts = fso.OpenTextFile(FileName:=strTextFile, _
1
IOMode:=ForWriting, _
1
Create:=True)
1
ts.WriteBlankLines 1
1
ts.WriteLine "Document Property Fields in " &amp; strDoc
1
ts.WriteLine "--------------------------------------------------"
1
ts.WriteBlankLines 1

 

1
For Each wfld In doc.Fields
1
If wfld.Type = wdFieldDocProperty Then
1
strCode = wfld.Code

 

1
<strong><em>              'Clean up doc prop name as needed</em></strong>
1
If Mid(strCode, 13) = Chr(34) Then
1
strDPName = Mid(strCode, 14)
1
Else
1
strDPName = Mid(strCode, 13)
1
End If

 

1
intPos = Nz(InStr(strDPName, ""))

 

1
If intPos &gt; 0 Then
1
strDPName = Left(strDPName, intPos - 1)
1
End If

 

1
strDPName = Replace(strDPName, Chr(34), "")
1
strDPName = Replace(strDPName, Chr(32), "")
1
Debug.Print strDPName

 

1
<strong><em>               'Add doc prop name to table</em></strong>
1
rst.AddNew
1
rst![DocumentName] = doc.Name
1
rst![DocPropertyFieldName] = strDPName
1
rst.Update
1
ts.WriteLine strDPName
1
End If
1
Next wfld
1
End If
1
Next fil

 

1
rst.Close
1
ts.Close

 

1
<strong><em>   'Open text file</em></strong>
1
Call Shell(PathName:="Notepad.exe " &amp; strTextFile, _
1
windowstyle:=vbNormalFocus)

 

1
ErrorHandlerExit:
1
Set rst = Nothing
1
Set fso = Nothing
1
Set ts = Nothing
1
Exit Sub

 

1
ErrorHandler:
1
If Err.Number = 5792 Then
1
strTitle = "File problem"
1
strPrompt = strDoc &amp; " is corrupted; can't process it"
1
MsgBox prompt:=strPrompt, _
1
buttons:=vbInformation + vbOKOnly, _
1
Title:=strTitle
1
GoTo ErrorHandlerExit
1
ElseIf Err = 429 Then
1
<strong><em>      'Word is not running; open Word with CreateObject</em></strong>
1
Set appWord = CreateObject("Word.Application")
1
Resume Next
1
Else
1
MsgBox "Error No: " &amp; Err.Number _
1
&amp; " in GetUsedDocPropsForFolder; " _
1
&amp; "Description: " &amp; Err.Description
1
Resume ErrorHandlerExit
1
End If

 

1
End Sub

When the procedure finishes, the text file listing the used doc properties in the selected document opens (for folder processing, just the first text file opens).  Note that there can be lots more doc properties in a document than are actually used – this will happen, for example, if you have a standard template prefilled with all the doc props that might be used, but a template copied from this template will only use a few.

One document I tested has over 100 doc props:

AW 1710-B

Figure B.  A selection of the doc props in a document

But only a few are actually used.

AW 1710-C

Figure C. A text file listing the used doc props in a document

References

The code in the sample database needs the following references (in addition to the default references):

Microsoft Scripting Runtime

Microsoft Office 14.0 Object Library

Microsoft Word 14.0 Object Library

Microsoft Forms 2.0 Object Library (for SortDeclarations procedure only)

If you import code or objects into a database of your own, you may need to set one or more of these references. The version number may differ, depending on your Office version; check the version you have.  References are set in the References dialog, opened from the VBA window.  For more information on working with references, see Access Archon #107, Working with References.

Supporting Files

The zip file containing this article, in Word 97-2003 format, plus the supporting file(s), may be downloaded from the Access Archon page of my Web site, as accarch245.zip, which is the last entry in the table of Access Archon columns for Access Watch.

Document Name Document Type Place in
Listing Used Doc Props (AA 245).accdb Access 2007-2010 database (can also be used in higher versions of Access) Wherever you want

Want More?

Office Watch has the latest news and tips about Microsoft Office.  Delivered once a week.