Access 2003: Exporting query to a word doc

In what way do you want to improve on what you are doing at the moment?

There are a couple of Word mechanisms which might suit you. Basically they are non-cod, but you might want to automate them, especially if you are already driving from Access and using code already.

The first uses a Database field. In Word, you do Insert>Field, find the Database field entry. There are some dialogues where you can select the database and then the  query or table. I have just tested this in Word 2007, where there is a choice to enter the data as a filed or not. As a field, the data will be linked, and up-datable via Access and a Word field refresh. Otherwise a plain table will result.

Another technique is the use a Mail Merge with the Directory option. This can be used to create a table.

If I were doing it in VBA, I would create a table in Word and step through the recordset adding a row to the table for each record, and filling each cell in the row from the appropriate recordset field.

If you want more on any of there approeaches, let us know.

For the code window, click on the word 'code' in the Comment editing box. This will insert some tags for code and end code. Put you code between them. I don't want to actually show them, because they will probably get interpreted.

Hi Graham,

tx so much for writing....

Can you help me with the approach to write the record set one row at a time to a table,
please?

Is it possible to hide the table separator lines, though,  bec. this word doc is going to
the printer's office to produce a graduation commencement program.

Tx for explaining about the <codes>, i understand now....

tx, s

Hi Graham,

i just experimented in word

table/insert table/ 1 column by 20 rows/right click on table/borders and shading/select none

print preview shows that lines are now hidden.

so i supposed i could open the document via vba,
     but how do i add rows to the table via vba if i need more than my initial 20 rows?

tx again, s

Hi Graham,

something like this?

http://www.dbforums.com/microsoft-access/1667358-export-data-word-table-using-vba.html

tx, s

Hi Graham,

Let me experiment with your code and get back to you...

tx so much, s

Hi Graham,

tx! got your code to work...

 have a questions, please:

a)  why are we subtracting 1 from c here:

wdRow.Cells(c).Range.Text = rst.fields(c - 1).Value

b) so when creating a table via code, the DEFAULT is no lines in the table?
    that's what it appears to be...

c) how do you open a related question in the new EE interface?
    i would like to ask:
           at end of record set loop,
               would like to highlight the entire document
               set the font stye
               then set the font size
     
      can you pls let me know how to post a related question, so i can post this?

tx again, s

a) As I recall, the fields collection is zero-based, while the cells collection is one-based

b) I don't think that you can create a Word table without any rows, however the code specifies one row, so it is a bit academic.

c) You don't have to select (highlight) the document. Just set the range to the formatting that you require

With wdDoc.Range.Font
     .Name = "Arial"
     .Size = 12
End with

Hi Graham,

tx for explaining about zero based, and tx for the code for font style and size - it works


i just have a question about opening word,  i learn from pasting other people's code

so i am feeling weak about how i open word.....

would like to word to open from scratch if not open already
 and if open already open another version

do you know how to modify the (simplified) code below to do that?

would gladly open a related/new post.... pls advise.... before answering  tx, s

=============

<code>

   
'Open Word

' Set appWord = GetObject(, "Word.Application")
Set appWord = New Word.Application
appWord.Documents.Add
appWord.Visible = True

Set wdDoc = appWord.ActiveDocument


   
strQueryName_Input = "qp_320d_AOA_OnCommencement_ForPrinter"

Set db = CurrentDb()
Set qdf = db.QueryDefs(strQueryName_Input)
Set rst = qdf.OpenRecordset

   
Do Until rst.EOF
Loop



''=========================
'' save as word doc
''=========================

wdDoc.SaveAs pg_strResultFullPath

wdDoc.Close savechanges:=False

appWord.Quit


finishup:

Set appWord = Nothing
Set wdDocs = Nothing
Set wdDoc = Nothing


Set fl = Nothing
Set fs = Nothing
Set f = Nothing

rst.Close
db.Close

Set fld = Nothing
Set t = Nothing
Set rst = Nothing
Set qdf = Nothing
Set db = Nothing


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
<code>

Precisely how Word is started depends on whiter or not you are aiming for a unique instance of Word , or not.

If the user doesn't need to see the document, and if the code is certain not to abort, then a separate, hidden, Word instance is acceptable.

If, however, the user might need to see, edit or just be aware of, the created document, then it would be better to use an existing instance of Word, if there is one.
 
Whether or not you require a new instance of the Word application rather depends on th circumstances.

Don't bother with setting all the objects to Nothing at the end of procedures. VB(A) does that automatically, so it just clutters the code

For the first:

Sub OpenNewInstance
Dim appWord as Word.Application
Set appWord  = CreateObject("Word.Application")
'
'Process, including a save
appWord.Quit
End Sub

Select allOpen in new window

For the second

Sub UseExistingOrOpenNewInstance()
    Dim appWord As Word.Application
    Dim bNewInstance As Boolean
    
    On Error Resume Next 'supress error checking
    Set appWord = GetObject(, "Word.Application")
    On Error GoTo 0 'resume error checking
    
    If appWord Is Nothing Then
        Set appWord = CreateObject("Word.Application")
        appWord.Visible = True
        bNewInstance = True
    End If
    '...
    'document processing here
    '...
    If bNewInstance = True Then 'only quit the application
        appWord.Quit
    End If
End Sub

Select allOpen in new window

Hi Graham,

i have to leave a little early today....

tx sooo much for all your help today.... tx for the additional code ....

will study the code that you provided, tommorrow...

tx again, s

OK. Sleep well. My own bedtime is beckoning.

Hi Graham,

Am back on this project... sorry for the delay

Below is an adaptation of all the code you supplied, including testing the word instance.

It works beautifully.... thank you!!

one tiny question,
       sometimes, when i run this code i get an error msg from word, if i want to change
       the normal.dot template, and i cancel, then run code, and code runs fine.

       are you familiar with the situation(s) that would cause word to display this msg?

tx again, s


'====

Option Compare Database

Option Explicit
 
Public Sub test_word()

Call w005_PrintCommencementPgm

End Sub
 
 
Public Sub w005_PrintCommencementPgm()
                                             
On Error GoTo ErrorHandler

Dim db                 As DAO.Database
Dim rst                As DAO.Recordset
Dim qdf                As DAO.QueryDef

Dim t                  As DAO.TableDef
Dim fld                As DAO.Field

Dim appWord                As Word.Application
Dim wdDocs                 As Word.Documents
Dim wdDoc                  As Word.Document

Dim wdTable                As Word.Table
Dim wdRow                  As Word.Row
Dim wdRange                As Word.Range
Dim wdCell                 As Word.Cell

Dim fs                    As FileSystemObject
Dim fl                    As Folder
Dim f                     As File

' strings
Dim strQueryName_Input         As String
Dim strWordResultfile          As String
Dim strBackMode                As String
Dim strBackHour                As String

Dim strBackServerLoc           As String
Dim strBackPgmsFolder          As String
Dim strBackOutputFolder        As String
Dim strBackPicturesDrive       As String
Dim strBackPicturesFolder      As String


' longs
Dim lngRecordCount         As Long

' integers
Dim c                                  As Integer

' booleans
Dim blnBackGoodIO          As Boolean
Dim bNewInstance            As Boolean


'file scripting
Set fs = CreateObject("Scripting.FileSystemObject")


Call z932_WhichProcessMode(strBackMode, _
                           strBackHour, _
                           blnBackGoodIO)

pg_strUserName = strGetUserName


Call q899_SelectTable_ServerLoc(pg_strTableName_ServerLoc, _
                                "0001", _
                                strBackServerLoc, _
                                strBackPgmsFolder, _
                                strBackOutputFolder, _
                                strBackPicturesDrive, _
                                strBackPicturesFolder, _
                                blnBackGoodIO)
                               
pg_strShareServer = strBackServerLoc
pg_strPgmsFolder = strBackPgmsFolder
pg_strOutputFolder = strBackOutputFolder
   
   


pg_strResultFullPath = pg_strShareServer & _
                     "\" & _
                     pg_strOutputFolder & _
                     "\" & _
                     "M4_CommencementPgm" & _
                     "\" & _
                     pg_strUserName & _
                     "\"


'====


Debug.Print pg_strResultFullPath

'Dim blnIfFolderExists As Boolean
'blnIfFolderExists = md(pg_strResultFullPath, _
'                       pg_strShareServer, _
'                       True)

Debug.Print "x"

If Not fs.FolderExists(pg_strResultFullPath) Then
       ' fs.CreateFolder (pg_strResultFullPath)
       MakeSureDirectoryPathExists (pg_strResultFullPath)
End If



'===
   
'Open Word

On Error Resume Next 'supress error checking
Set appWord = GetObject(, "Word.Application")
On Error GoTo 0 'resume error checking

If appWord Is Nothing Then
    Set appWord = CreateObject("Word.Application")
    appWord.Visible = True
    bNewInstance = True
End If





appWord.Documents.Add

Set wdDoc = appWord.ActiveDocument

 
strQueryName_Input = "qp_320d_AOA_OnCommencement_ForPrinter"

Set db = CurrentDb()
Set qdf = db.QueryDefs(strQueryName_Input)
Set rst = qdf.OpenRecordset

Set wdRange = wdDoc.Range(0, 0) 'start of document
Set wdTable = wdDoc.Tables.Add(wdRange, 1, rst.fields.Count)

Set wdRow = wdTable.Rows.First


'  fields collection is zero-based, while the cells collection is one-based
' https://www.experts-exchange.com/questions/27644488/Access-2003-Exporting-query-to-a-word-doc.html?anchorAnswerId=37754434#a37754434

'For c = 1 To rs.fields.Count
'    wdRow.Cells(c).Range.Text = rs.fields(c - 1).Name
'Next c
   
Do Until rst.EOF
    lngRecordCount = lngRecordCount + 1


    ' Set wdRow = wdTable.Rows.Add
   
    For c = 1 To rst.fields.Count
        wdRow.Cells(c).Range.Text = rst.fields(c - 1).Value
    Next c
   
    Set wdRow = wdTable.Rows.Add
   
    rst.MoveNext
Loop


With wdDoc.Range.Font
     .Name = "Calibri"
     .Size = 16
End With


   
     strWordResultfile = Format(Date, "YYYY_MM_DD") & _
                           "_" & _
                           "CommencementPgm" & _
                           ".doc"   '
                   
 
' pg_strResultFullPath = CurrentProject.Path & "\" & strWordResultfile
 
 pg_strResultFullPath = pg_strResultFullPath & strWordResultfile

Debug.Print pg_strResultFullPath

'* Delete the existing file
If dir(pg_strResultFullPath) <> "" Then
  Kill (pg_strResultFullPath)
End If

''=========================
'' save as word doc
''=========================

wdDoc.SaveAs pg_strResultFullPath

wdDoc.Close savechanges:=False

If bNewInstance = True Then 'only quit the application
   appWord.Quit
End If






MsgBox " Finished!.. " & _
       "Please check: " & _
       pg_strResultFullPath


finishup:

Set appWord = Nothing
Set wdDocs = Nothing
Set wdDoc = Nothing


Set fl = Nothing
Set fs = Nothing
Set f = Nothing

rst.Close
db.Close

Set fld = Nothing
Set t = Nothing
Set rst = Nothing
Set qdf = Nothing
Set db = Nothing


Set db = Nothing
Set rst = Nothing


ErrorHandlerExit:
   Exit Sub
ErrorHandler:
      MsgBox "Error No: " & err.Number & "; Description: " & err.Description
      Resume ErrorHandlerExit

End Sub