Filling Word Documents with Access Data Using the Type Text Method

You can create a blank Word document (based on the default Word template) with two lines of code:

Set appWord = GetObject(, "Word.Application") Set doc = appWord.Documents.Add


Word documents and templates

Working with Word bookmarks

Working with the TypeText method

Working with Word document properties

Working with form fields Working with tables l"r T" r ^'-■'■v^ 'n most of my Automation code working with other Office applications (Word, Excel, and Outlook), I use the GetObject function in the body of a procedure, to set a reference to the running instance of the application, if there is one; the procedure's error handler runs CreateObject if the application is not already running (see the code samples later in this chapter for examples). This prevents creation of multiple instances of Word, Excel, or Outlook.

If you don't need any fancy formatting, just a plain text document, you can fill a blank Word document with text using the TypeText method. The FillWithTypeText procedure listed next creates a blank Word document, then enters a document heading, then reads text from fields in an Access table and writes it directly to the Word document, and finally applies some simple formatting, using Word commands:

Private Sub FillWithTypeText ()

On Error GoTo ErrorHandler

Dim appWord As Word.Application

Dim doc As Word.Document

Dim dbs As DAO.Database

Dim rst As DAO.Recordset

Set appWord = GetObject(, "Word.Application")

Set doc = appWord.Documents.Add

Insert and format document title:

With appWord.Selection

.TypeText "Current Contacts as of " _

& Format(Date, "Long Date") .TypeParagraph

Extend:=wdExtend .Font.Size = 14 .Font.Bold = wdToggle .MoveDown Unit:=wdLine, Count:=1 End With

Insert a two-column table to hold contact data (one column for contact names, the other for user comments):

doc.Tables.Add Range:=Selection.Range, _ NumRows:=1, _ NumColumns:=2, _

DefaultTableBehavior:=wdWord9TableBehavior, _ AutoFitBehavior:=wdAutoFitFixed With appWord.Selection.Tables(1) If .Style <> "Table Grid" Then

.Style = "Table Grid" End If

.ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False .ApplyStyleRowBands = True .ApplyStyleColumnBands = False End With

Insert contact data from Access table into Word table: Set dbs = CurrentDb

Set rst = dbs.OpenRecordset("tblContacts") Do While Not rst.EOF

With appWord.Selection

.TypeText rst![LastName] & " & rst![FirstName] .MoveRight Unit:=wdCell, Count:=2 End With rst.MoveNext Loop

Delete the last, blank row:

appWord.Selection.Rows.Delete Sort contact names alphabetically:

doc.Tables(1).Select appWord.Selection.Sort ExcludeHeader:=False, _ FieldNumber:="Column 1", _ SortFieldType:=wdSortFieldAlphanumeric, _ SortOrder:=wdSortOrderAscending


Set appWord = Nothing Exit Sub


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

0 0

Post a comment