Solved

Access 2003: Exporting query to a word doc

Posted on 2012-03-22
13
374 Views
Last Modified: 2012-06-21
Hi EE,

Have a query that contains:

SELECT x.Asterisk & " " & x.Calc_DiplomaName & " " & x.Specialty AS Info
FROM TABLE_TEST
ORDER BY x.[Last Name], x.[First Name];


It create a 1 column field (that concantentates several fields)

Would like to export to word doc.

(the way i do it manually is:
       run the query, ctl+a, ctl+c, open word, ctl+v
               word has a little clipboard, from there i select text only
                       then ctl+a, and change the font style and size)

Want to do the above steps from Access using vba.

I learned how to open a word doc, that has properties placed in the doc like in a letter.

However, this is just dumping all the data instead of into excel using the copyrecordset command instead into word.

Does anybody have vba logic to do this?

Below pasted code that i used for a word doc with properties. Maybe you can help me
modify this code.

(Anybody know where i the code window is in the new EE interface?)

tx in advance for your help and ideas, sandra
0
Comment
Question by:mytfein
  • 8
  • 5
13 Comments
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 37754002
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.
0
 

Author Comment

by:mytfein
ID: 37754039
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
0
 

Author Comment

by:mytfein
ID: 37754061
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
0
 

Author Comment

by:mytfein
ID: 37754163
0
 
LVL 76

Accepted Solution

by:
GrahamSkan earned 500 total points
ID: 37754221
That would be something like this:
Sub FillWordTable()
    Dim wdTable As Word.Table
    Dim wdDoc As Word.Document
    Dim wdRow As Word.Row
    Dim wdRange As Word.Range
    Dim wdCell As Word.Cell
    Dim c As Integer
    
    Dim rs As ADODB.Recordset
    'or
    'Dim rs As DAO.Recordset
    '...
    
    'rs.open or openrecordset
    
    Set wdRange = wdDoc.Range(0, 0) 'start of document
    Set wdTable = wdDoc.Tables.Add(wdrrange, 1, rs.Fields.Count)
    
    Set wdRow = wdTable.Rows.First
    
    For c = 1 To rs.Fields.Count
        wdRow.Cells(c).Range.Text = rs.Fields(c - 1).Name
    Next c
    
    Do Until rs.EOF
        Set wdRow = wdTable.Rows.Add
        For c = 1 To rs.Fields.Count
            wdRow.Cells(c).Range.Text = rs.Fields(c - 1).Value
        Next c
        rs.MoveNext
    Loop

End Sub

Open in new window

0
 

Author Comment

by:mytfein
ID: 37754250
Hi Graham,

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

tx so much, s
0
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 

Author Comment

by:mytfein
ID: 37754383
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
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 37754434
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
0
 

Author Comment

by:mytfein
ID: 37754523
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>
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 37754714
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

Open 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

Open in new window

0
 

Author Comment

by:mytfein
ID: 37754741
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
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 37754898
OK. Sleep well. My own bedtime is beckoning.
0
 

Author Comment

by:mytfein
ID: 37777999
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
' http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_27644488.html#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
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Shortcuts in Word Just the other day I had a training for Microsoft and they wanted me to show how well the new Windows and Office behaved on a touch device, which by the way is great, but it was only then that I realized that using keyboard shortc…
This is written from a 'VBA for MS Word' perspective, but I am sure it applies to most other MS Office components where VBA is used.  One thing that really bugs me is slow code, ESPECIALLY when it's mine!  In programming there are so many ways to…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now