I need to create a report in MS Word populated with data from A2K. I
have been asked to create the report in Word so that parts of it can be
edited as necessary later. The data in the report are in a table with
headings for each column, so converting an Access report to a Word doc
in RTF doesn't work because only the text is converted, not the table.
What I have tried so far, with some success, is to write the report
directly in Word.
I've made a template (a Word document) for the report which consists of
a header and an empty table (1 row, 7 columns).
In a command button click event, I have written code to open the
template in MS Word, then using SendKeys, edit the header and enter the
data in to the cells of the table. Data is entered into the first cell
then Sendkeys TABs to the next cell, enters data, TABs to next cell...
I only enter data into the first three columns of each row. The
remaining cloumns will be filled by the user after the report is
generated.
The problem I am having is that SendKeys does not perform consistently.
When it does work correctly, it will do so for many repititions. When
it doesn't, it seems like the TABs are not being executed correctly -
data is printed to incorrect cells, some cells contain more than they
should. And the incorrect tabbing isn't consistent either within the
same execution or from one to another.
Is there some way to get SendKeys to work the same way every time I run
this sub?
Alternatively, I am open to suggestions of another (easier) way to
create my report in Word.
Thanks for any help offered.
The code for my sub follows.
Private Sub PrintToWord()
On Error GoTo Err_PrintToWord
Dim ReturnValue
Dim strTitle As String ' exam title
Dim strGrade As String ' salary grade
Dim strExamNum As String ' exam number
Dim strType As String ' type of appointment
Dim strLocation As String ' loacation of position
Dim strName As String ' name of Eligible
Dim strPhone As String ' phone number of Eligible
Dim strScore As String ' score on exam
Dim db As DAO.Database
Dim rsReport As DAO.Recordset
Set db = CurrentDb
Set rsReport = db.OpenRecordset("tblReportData")
rsReport.MoveFirst
strTitle = rsReport!Title
If rsReport!SalaryGrade <> Null Then
strGrade = rsReport!SalaryGrade
Else
strGrade = " "
End If
strExamNum = rsReport!ExamNum
strType = mstrApptType
strLocation = mstrLocation
ReturnValue = Shell("WINWORD.EXE template.doc", 1) ' Run Word
AppActivate ReturnValue ' Activate Word
' BEGIN HEADER
' open header
SendKeys "%vh", True
' enter title of exam and salary grade
SendKeys "{DOWN 2}", True
SendKeys "{ENTER}"
SendKeys "{TAB 3}", True
SendKeys strTitle, True
SendKeys ", ", True
SendKeys "SG-" & strGrade, True
' enter exam number
SendKeys "{ENTER}", True
SendKeys "{TAB 3}", True
SendKeys "{(}", True
SendKeys strExamNum, True
SendKeys "{)}", True
' enter type of appointment
SendKeys "{DOWN 4}", True
SendKeys "{TAB 3}", True
SendKeys "PERMANENT", True
' enter location
SendKeys "{TAB 7}", True
SendKeys "LOCATION", True
' close header
SendKeys "%C", True
' END HEADER
' goto first cell of table
SendKeys "{DOWN}", True
' enter first Eligble
' assign data
strName = rsReport!EligName
If rsReport!Phone <> Null Then
strPhone = rsReport!Phone
Else
strPhone = " "
End If
strScore = rsReport!Score
' print name
SendKeys strName, True
' move to next cell and print phone
SendKeys "{TAB}", True
SendKeys strPhone, True
' move to next cell and print score
SendKeys "{TAB}", True
SendKeys strScore, True
' move to end of row
SendKeys "{TAB 4}", True
rsReport.MoveNext
' enter remaining Eligibles
Do While Not rsReport.EOF
' create new row
SendKeys "{TAB}", True
' assign data
strName = rsReport!EligName
If rsReport!Phone <> Null Then
strPhone = rsReport!Phone
Else
strPhone = " "
End If
strScore = rsReport!Score
' print name
SendKeys strName, True
' move to next cell and print phone
SendKeys "{TAB}", True
SendKeys strPhone, True
' move to next cell and print score
SendKeys "{TAB}", True
SendKeys strScore, True
' move to end of row
SendKeys "{TAB 4}", True
rsReport.MoveNext
Loop
' open "Save As" dialog
SendKeys "%fa", True
Exit_PrintToWord:
Exit Sub
Err_PrintToWord:
MsgBox Err.Description
Resume Exit_PrintToWord
End Sub
