Export Data to Word

Export data to word

A common problem that crops up when dealing with Microsoft Access is how to export data to  Microsoft Word.

As an example you may have set up a database, and you have developed a query of which you wish to add the results to a Microsoft Word document.

I have used this process for a few different databases so thought I would share this code with you so you can export data to word in your own databases.

I have used two different ways in the databases I have developed. I have on occassions used bookmarks, but for this example I will use tables.

To set this up:

Create the word document, with the predetermined text, header and footer etc, then add a table where you want the data to go, just one row, but as many columns as you have fields in your output. Save the file as a document template.

Once you have done that use the following code:

Public Sub sWordTables()

Dim appWord As Object 'Word.Application
Dim WordDoc As Object 'Word.Document
Dim db As Object
Dim rst As Object
Dim strPath As String
Dim intholder As Integer

strPath = "C:\Users\Julie\Documents\Simply Access\Allexperts\AllExperts\" ' change to the path where document template is

Set db = CurrentDb
Set rst = db.OpenRecordset("tblCustomer1") 'Change to the name of table/query you wish to ouput

'Opens word with the appropriate template
Set appWord = CreateObject("Word.Application")
appWord.Visible = True
Set WordDoc = appWord.Documents.Add(strPath & "doc1.dot") ' change doc1 to the name or your template

intholder = 1
rst.MoveFirst

'Populate the table
Do Until rst.EOF
appWord.ActiveDocument.Tables(1).Cell(intholder, 1).Range.Text = Nz(rst!BusinessName, "") 'change the names of the fields to suit.
appWord.ActiveDocument.Tables(1).Cell(intholder, 2).Range.Text = Nz(rst!FirstName, "")
appWord.ActiveDocument.Tables(1).Cell(intholder, 3).Range.Text = Nz(rst!Surname, "")
appWord.ActiveDocument.Tables(1).Cell(intholder, 4).Range.Text = Nz(rst!Suburb, "")

'You may need to add in more depending on how many columns you have

appWord.ActiveDocument.Tables(1).Rows.Add
intholder = intholder + 1
rst.MoveNext
Loop

appWord.ActiveDocument.Tables(1).Rows(intholder).Delete

Set appWord = Nothing

Exit Sub

Errorhandler:
If Err.Number = 0 Then
'Do this
Else
MsgBox Err.Number & ": " & Err.Description, , "Error Message"
End If

End Sub