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:
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:
Public Sub GetUsedDocPropsForDocument()
On Error GoTo ErrorHandler
strTable = "tblDocPropFields"
strSQL = "DELETE * FROM " & strTable
CurrentDb.Execute strSQL
'Select file, using an Office FileDialog FilePicker dialog
strFileNameAndPath = SelectFile
Set appWord = GetObject(, "Word.Application")
appWord.Visible = True
Set doc = appWord.Documents.Open(strFileNameAndPath)
strDoc = doc.Name
strDoc = Mid(strDoc, 1, InStrRev(strDoc, ".") - 1)
strDocsPath = GetProperty("WordDocsPath", "")
strTextFile = strDocsPath & "\Doc property fields in " _
& strDoc & ".txt"
Debug.Print "Text file: " & strTextFile
Set rst = CurrentDb.OpenRecordset(strTable)
'Open text file in same folder as document
Set ts = fso.OpenTextFile(FileName:=strTextFile, _
IOMode:=ForWriting, _
Create:=True)
ts.WriteBlankLines 1
ts.WriteLine "Document Property Fields in " & strDoc
ts.WriteLine "--------------------------------------------------"
ts.WriteBlankLines 1
For Each wfld In doc.Fields
If wfld.Type = wdFieldDocProperty Then
strCode = wfld.Code
'Clean up doc prop name as needed
If Mid(strCode, 13) = Chr(34) Then
strDPName = Mid(strCode, 14)
Else
strDPName = Mid(strCode, 13)
End If
intPos = Nz(InStr(strDPName, "\"))
If intPos > 0 Then
strDPName = Left(strDPName, intPos - 1)
End If
strDPName = Replace(strDPName, Chr(34), "")
strDPName = Replace(strDPName, Chr(32), "")
Debug.Print strDPName
'Add doc prop name to table
rst.AddNew
rst![DocumentName] = doc.Name
rst![DocPropertyFieldName] = strDPName
rst.Update
'Write line with doc prop name to text file
ts.WriteLine strDPName
End If
Next wfld
rst.Close
ts.Close
'Open text file
Call Shell(PathName:="Notepad.exe " & strTextFile, _
windowstyle:=vbNormalFocus)
ErrorHandlerExit:
Set rst = Nothing
Set fso = Nothing
Set ts = Nothing
Exit Sub
ErrorHandler:
If Err.Number = 5792 Then
strTitle = "File problem"
strPrompt = strDoc & " is corrupted; can't process it"
MsgBox prompt:=strPrompt, _
buttons:=vbInformation + vbOKOnly, _
Title:=strTitle
GoTo ErrorHandlerExit
ElseIf Err = 429 Then
'Word is not running; open Word with CreateObject
Set appWord = CreateObject("Word.Application")
Resume Next
Else
MsgBox "Error No: " & Err.Number _
& " in GetUsedDocPropsForDocument procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End If
End Sub
Public Sub GetUsedDocPropsForFolder()
On Error GoTo ErrorHandler
strTable = "tblDocPropFields"
strSQL = "DELETE * FROM " & strTable
CurrentDb.Execute strSQL
Set appWord = GetObject(, "Word.Application")
appWord.Visible = False
strDocsPath = GetProperty("WordDocsPath", "")
'Get folder of documents to process from custom database property
Set fld = fso.GetFolder(strDocsPath)
For Each fil In fld.Files
If (Right(fil.Name, 3) = "doc" Or Right(fil.Name, 4) = "docx" _
Or Right(fil.Name, 3) = "dot" Or Right(fil.Name, 4) = "dotx") _
And (Left(fil.Name, 1) <> "~" _
And Nz(InStr(fil.Name, "Copy")) = 0) Then
strFileNameAndPath = strDocsPath & "\" & fil.Name
Debug.Print "File to process: " & strFileNameAndPath
Set doc = appWord.Documents.Open(strFileNameAndPath)
strDoc = doc.Name
strDoc = Mid(strDoc, 1, InStrRev(strDoc, ".") - 1)
strTextFile = strDocsPath & "\Doc property fields in " _
& strDoc & ".txt"
'Debug.Print "Text file: " & strTextFile
Set rst = CurrentDb.OpenRecordset(strTable)
'Open text file in same folder as documents
Set ts = fso.OpenTextFile(FileName:=strTextFile, _
IOMode:=ForWriting, _
Create:=True)
ts.WriteBlankLines 1
ts.WriteLine "Document Property Fields in " & strDoc
ts.WriteLine "--------------------------------------------------"
ts.WriteBlankLines 1
For Each wfld In doc.Fields
If wfld.Type = wdFieldDocProperty Then
strCode = wfld.Code
'Clean up doc prop name as needed
If Mid(strCode, 13) = Chr(34) Then
strDPName = Mid(strCode, 14)
Else
strDPName = Mid(strCode, 13)
End If
intPos = Nz(InStr(strDPName, "\"))
If intPos > 0 Then
strDPName = Left(strDPName, intPos - 1)
End If
strDPName = Replace(strDPName, Chr(34), "")
strDPName = Replace(strDPName, Chr(32), "")
Debug.Print strDPName
'Add doc prop name to table
rst.AddNew
rst![DocumentName] = doc.Name
rst![DocPropertyFieldName] = strDPName
rst.Update
ts.WriteLine strDPName
End If
Next wfld
End If
Next fil
rst.Close
ts.Close
'Open text file
Call Shell(PathName:="Notepad.exe " & strTextFile, _
windowstyle:=vbNormalFocus)
ErrorHandlerExit:
Set rst = Nothing
Set fso = Nothing
Set ts = Nothing
Exit Sub
ErrorHandler:
If Err.Number = 5792 Then
strTitle = "File problem"
strPrompt = strDoc & " is corrupted; can't process it"
MsgBox prompt:=strPrompt, _
buttons:=vbInformation + vbOKOnly, _
Title:=strTitle
GoTo ErrorHandlerExit
ElseIf Err = 429 Then
'Word is not running; open Word with CreateObject
Set appWord = CreateObject("Word.Application")
Resume Next
Else
MsgBox "Error No: " & Err.Number _
& " in GetUsedDocPropsForFolder; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End If
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:
Figure B. A selection of the doc props in a document
But only a few are actually used.
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 |
