Skip to content

Working with Word Document Properties, Part 2

Access Archon #174

The code that does the work of listing, clearing and copying doc properties is listed below.


VBA Code

Private Sub cmdCopy_Click()

 

On Error GoTo ErrorHandler

 

   Dim cbo As Access.ComboBox

   Dim intType As Integer

  

   Set cbo = Me![cboSelectTableOrQuery]

   strTemplate = Nz(Me![txtTemplate].Value)

   strRecordSource = Nz(cbo.Column(0))

   intType = Nz(cbo.Column(1))

  

   If strTemplate <> “” Then

      strTitle = “Question”

      strPrompt = “Strip old doc properties first?”

      intReturn = MsgBox(prompt:=strPrompt, _

         buttons:=vbQuestion + vbYesNoCancel, _

         Title:=strTitle)

      If intReturn = vbYes Then

         Call StripDocProps(strTemplate)

      ElseIf intReturn = vbCancel Then

         GoTo ErrorHandlerExit

      End If

     

      Call CopyDocProps(strTemplate, strRecordSource, intType)

   End If

  

ErrorHandlerExit:

   Exit Sub

 

ErrorHandler:

   MsgBox “Error No: ” & Err.Number _

      & “; Description: ” & Err.Description

   Resume ErrorHandlerExit

 

End Sub

 

Private Sub cmdList_Click()

 

On Error GoTo ErrorHandler

 

   strTemplate = Nz(Me![txtTemplate].Value)

   Debug.Print “Selected template: ” & strTemplate

   If strTemplate <> “” Then

      Call ListDocProps(strTemplate)

   End If

  

ErrorHandlerExit:

   Exit Sub

 

ErrorHandler:

   MsgBox “Error No: ” & Err.Number _

      & “; Description: ” & Err.Description

   Resume ErrorHandlerExit

 

End Sub

 

Private Sub cmdSelectTemplate_Click()

‘Requires a reference to the Microsoft Office Object Library

 

On Error GoTo ErrorHandler

 

   Dim fd As Office.FileDialog

   Dim varSelectedItem As Variant

   Dim txt As Access.TextBox

   Dim strTemplatesPath As String

  

   ‘Get User Templates path from Word Options dialog

   Set appWord = GetObject(, “Word.Application”)

   strTemplatesPath = _

      appWord.Options.DefaultFilePath(wdUserTemplatesPath) & “”

   Debug.Print “Templates folder: ” & strTemplatesPath

  

   ‘Create a FileDialog object as a File Picker dialog box.

   Set fd = Application.FileDialog(msoFileDialogFilePicker)

   Set txt = Me![txtTemplate]

  

   With fd

      .AllowMultiSelect = False

      .Title = “Browse for Word Template”

      .ButtonName = “Select”

      .Filters.Clear

      .Filters.Add “Documents”, “*.dot; *.dotx; *.dotm”, 1

      .InitialView = msoFileDialogViewDetails

      .InitialFileName = strTemplatesPath

      If .Show = -1 Then

         ‘Get selected item in the FileDialogSelectedItems collection

         ‘Have to use collection even if just one item is selected

         For Each varSelectedItem In .SelectedItems

            txt.Value = CStr(varSelectedItem)

            Me![cmdList].Enabled = True

         Next varSelectedItem

      Else

         Debug.Print “User pressed Cancel”

         Me![cmdList].Enabled = False

      End If

   End With

  

ErrorHandlerExit:

   Set fd = Nothing

   Exit Sub

 

ErrorHandler:

   If Err = 429 Then

      ‘Word is not running; open Word with CreateObject

      Set appWord = CreateObject(“Word.Application”)

      Resume Next

   Else

      MsgBox “Error No: ” & Err.Number & “; Description: ” _

         & Err.Description

      Resume ErrorHandlerExit

   End If

 

End Sub

 

Private Sub CopyDocProps(strTemplate As String, _

   strRecordSource As String, intType As Integer)

 

On Error GoTo ErrorHandler

 

   Set dbs = CurrentDb

   If intType = 1 Then

      Set tdf = dbs.TableDefs(strRecordSource)

   ElseIf intType = 5 Then

      Set qdf = dbs.QueryDefs(strRecordSource)

   End If

  

   Set appWord = GetObject(, “Word.Application”)

   Set docTarget = appWord.Documents.Add(Template:=strTemplate)

   Set dps = docTarget.AttachedTemplate.CustomDocumentProperties

   appWord.Visible = True

  

   If intType = 1 Then

      ‘Iterate through table fields and create doc properties

      For Each fld In tdf.Fields

         strPropName = fld.Name

         Debug.Print “Field name: ” & strPropName

         Debug.Print “Field data type: ” & fld.Type

         If fld.Type = dbBoolean Then

            dps.Add Name:=strPropName, LinkToContent:=False, _

               Type:=msoPropertyTypeBoolean, Value:=””

         Else

  

On Error Resume Next

            dps.Add Name:=strPropName, LinkToContent:=False, _

               Type:=msoPropertyTypeString, Value:=””

         End If

      Next fld

  

   ElseIf intType = 5 Then

      If qdf.Fields.Count = 0 Then

         strTitle = “No fields”

         strPrompt = “This query has no usable fields (it is ” _

            & “probably an action query)”

         MsgBox prompt:=strPrompt, _

            buttons:=vbExclamation + vbOKOnly, _

            Title:=strTitle

         docTarget.Close savechanges:=False

         GoTo ErrorHandlerExit

      End If

      For Each fld In qdf.Fields

         ‘Iterate through query fields and create doc properties

         strPropName = fld.Name

         Debug.Print “Field name: ” & strPropName

         Debug.Print “Field data type: ” & fld.Type

         If fld.Type = dbBoolean Then

            dps.Add Name:=strPropName, LinkToContent:=False, _

               Type:=msoPropertyTypeBoolean, Value:=””

         Else

  

On Error Resume Next

            dps.Add Name:=strPropName, LinkToContent:=False, _

               Type:=msoPropertyTypeString, Value:=””

         End If

      Next fld

   End If

 

On Error GoTo ErrorHandler

  

   ‘Make a dummy change so doc props will be saved

   With appWord.Selection

      .EndKey Unit:=wdStory

      .TypeText Text:=”Dummy text”

      .HomeKey Unit:=wdLine, Extend:=wdExtend

      .Delete Unit:=wdCharacter, Count:=1

   End With

   docTarget.AttachedTemplate.Save

   docTarget.Close savechanges:=False

     

   strTitle = “Finished!”

   strPrompt = “All doc properties from ” & strRecordSource _

      & ” copied to ” & strTemplate

   MsgBox prompt:=strPrompt, _

      buttons:=vbInformation + vbOKOnly, _

      Title:=strTitle

  

ErrorHandlerExit:

   Exit Sub

 

ErrorHandler:

   If Err = 429 Then

      ‘Word is not running; open Word with CreateObject

      Set appWord = CreateObject(“Word.Application”)

      Resume Next

   Else

      MsgBox “Error No: ” & Err.Number & “; Description: ” _

         & Err.Description

      Resume ErrorHandlerExit

   End If

 

End Sub

 

Private Sub ListDocProps(strTemplate As String)

 

On Error GoTo ErrorHandler

 

   Set appWord = GetObject(, “Word.Application”)

   strTemplate = Nz(Me![txtTemplate].Value)

   Set docTarget = appWord.Documents.Add(Template:=strTemplate)

   Set dps = docTarget.AttachedTemplate.CustomDocumentProperties

   appWord.Visible = True

  

   With appWord.Selection

      .WholeStory

      .Delete Unit:=wdCharacter, Count:=1

      .Font.Name = “Arial”

      .Font.Size = 12

      .Font.Bold = True

      .TypeText “Document properties in ” & strTemplate

      .EndKey Unit:=wdLine

      .TypeParagraph

      .TypeParagraph

     

      appWord.ActiveDocument.Tables.Add _

         Range:=appWord.Selection.Range, _

         NumRows:=2, NumColumns:=1, _

         DefaultTableBehavior:=wdWord9TableBehavior, _

         AutoFitBehavior:=wdAutoFitFixed

      With appWord.Selection.Tables(1)

         .Style = “Table Grid”

         .ApplyStyleHeadingRows = True

         .ApplyStyleLastRow = False

         .ApplyStyleFirstColumn = True

         .ApplyStyleLastColumn = False

      End With

     

      appWord.ActiveDocument.Tables(1).Select

     

      With appWord.Selection

         .Borders(wdBorderTop).LineStyle = wdLineStyleNone

         .Borders(wdBorderLeft).LineStyle = wdLineStyleNone

         .Borders(wdBorderBottom).LineStyle = wdLineStyleNone

         .Borders(wdBorderRight).LineStyle = wdLineStyleNone

         .Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone

         .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone

         .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone

         .Font.Name = “Arial”

         .Font.Size = 10

         .Font.Bold = False

      End With

        

      appWord.Selection.MoveLeft Unit:=wdCharacter, Count:=1

   End With

  

   If dps.Count > 0 Then

      For Each dp In dps

         With appWord.Selection

            .TypeText dp.Name

            .MoveRight Unit:=wdCell

         End With

      Next dp

  

      ‘Delete last, blank row

      With appWord.Selection

          .SelectRow

         .Rows.Delete

      End With

   Else

      appWord.Selection.TypeText _

         “There are no doc properties in this template”

   End If

  

   appWord.ActiveDocument.Tables(1).Select

   appWord.Selection.Sort ExcludeHeader:=False, _

      FieldNumber:=”Column 1″, _

      SortFieldType:=wdSortFieldAlphanumeric, _

      SortOrder:=wdSortOrderAscending

 

   appWord.Activate

   appWord.Selection.HomeKey Unit:=wdStory

 

ErrorHandlerExit:

   Exit Sub

 

ErrorHandler:

   If Err = 429 Then

      ‘Word is not running; open Word with CreateObject

      Set appWord = CreateObject(“Word.Application”)

      Resume Next

   Else

      MsgBox “Error No: ” & Err.Number & “; Description: ” _

         & Err.Description

      Resume ErrorHandlerExit

   End If

 

End Sub

 

Private Sub StripDocProps(strTemplate As String)

 

On Error GoTo ErrorHandler

 

   Set appWord = GetObject(, “Word.Application”)

   strTemplate = Nz(Me![txtTemplate].Value)

   Set docTarget = appWord.Documents.Add(Template:=strTemplate)

   Set dps = docTarget.AttachedTemplate.CustomDocumentProperties

   appWord.Visible = True

  

   For Each dp In dps

      Debug.Print “Deleting ” & dp.Name

      dp.Delete

   Next dp

 

   ‘Make a dummy change so changes will be saved

   With appWord.Selection

      .EndKey Unit:=wdStory

      .TypeText Text:=”Dummy text”

      .HomeKey Unit:=wdLine, Extend:=wdExtend

      .Delete Unit:=wdCharacter, Count:=1

   End With

   docTarget.AttachedTemplate.Save

   docTarget.Close savechanges:=False

     

ErrorHandlerExit:

   Set appWord = Nothing

   Exit Sub

 

ErrorHandler:

   If Err = 429 Then

      ‘Word is not running; open Word with CreateObject

      Set appWord = CreateObject(“Word.Application”)

      Resume Next

   Else

      MsgBox “Error No: ” & Err.Number & “; Description: ” _

         & Err.Description

      Resume ErrorHandlerExit

   End If

 

End Sub

 


Notes

If you select an action query, you will get a message that there are no usable fields (a few make-table queries are included in the database, for testing).  This is because only select queries have usable fields.  If you need to use data in an action query, run the action query, and then use the table it created (or modified) for creating the doc properties.  The tables in the sample database with the “tmak” prefix were created by running make-table queries.

Since Word doc properties can’t contain spaces, make sure that the Access fields also contain no spaces.  If necessary, you can create a query that aliases field names with new names that don’t contain spaces, to prevent problems when creating doc properties.


References

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

Microsoft DAO 3.6 Object Library

Microsoft Word 11.0 Object Library

Microsoft Office 11.0 Object Library

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 accarch174.zip, which is the last entry in the table of Access Archon columns for Access Watch.



















Document Name

Document Type

Place in

Doc Props (AA 174).mdb

Access 2002-2003 database

Wherever you want

Doc Props (AA 174).accdb

Access 2007 database

Wherever you want

White Paper — Adding Custom Doc Properties to a Word Template.doc

Word 97-2003 document

Wherever you want

 

About this author