W
Wissam
I am new to access. I am trying to automatically merge data from access to a
word template, and fill data in a word table. I am trying to write a code
adopting a sample code from http://www.helenfeddema.com; column 44. My code
is shown below. The merged file document gets opened with merger of the
fields in the main bulk of the document. However, the word table is not being
filled and I get the following error in access: “Error No: 4120; Description:
Bad parameterâ€. I spent 2 days trying to “fix†this, in vain. I would
appreciate any help.
Code:
*******************************************
Private Sub cmdCreateNote_Click()
Dim dbs As Database
Dim objDocs As Object
Dim objWord As Object
Dim prps As Object
Dim rst As Recordset
Dim blnSaveNameFail As Boolean
Dim dteTodayDate As Date
Dim strName As String
Dim strAge As String
Dim strSex As String
Dim strDiabetes As String
Dim lngTC As Long
Dim lngLDL As Long
Dim strDoc As String
Dim strDocsPath As String
Dim strSaveName As String
Dim strSaveNamePath As String
Dim strShortDate As String
Dim strTemplatePath As String
Dim strWordTemplate As String
Dim strTestFile As String
Dim strTest As String
Dim strMessageTitle As String
Dim strMessage As String
Dim intReturn As Integer
Dim intCount As Integer
'Create a Word instance to use for the invoice; uses the existing Word
'instance if there is one, otherwise creates a new instance
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If Err.Number = 429 Then
'Word is not running; creating a Word object
Set objWord = CreateObject("Word.Application")
Err.Clear
End If
'Sets up error handler for the rest of the procedure
On Error GoTo cmdCreateNote_ClickErr
'Run make-table queries to create tables to use for export.
DoCmd.SetWarnings False
DoCmd.OpenQuery "qHistory"
DoCmd.OpenQuery "qVisit"
DoCmd.SetWarnings True
'Check that there is a patient record filled before creating note.
intCount = DCount("*", "tqHistory")
Debug.Print "Number of Patients: " & intCount
If intCount < 1 Then
MsgBox "No patient selected; cancelling"
Exit Sub
End If
'Create recordset and get needed word document properties for this note.
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tqHistory", dbOpenDynaset)
With rst
'The Nz function is used to convert any Nulls to zeros or
'zero-length strings, to prevent problems with exporting
'to Word.
strName = Nz(![Name])
strAge = Nz(![Age]) 'age was converted to string in the query using
cstr([age]).
Debug.Print "Age: " & strAge
strSex = Nz(![Sex])
Debug.Print "Sex = " & strSex
strDiabetes = Nz(![Diabetes])
Debug.Print "Diabetes: " & strDiabetes
End With
rst.Close
strDocsPath = objWord.Options.DefaultFilePath(wdUserTemplatesPath) & "\"
Debug.Print "Docs path: " & strDocsPath
strTemplatePath = objWord.Options.DefaultFilePath(wdUserTemplatesPath) &
"\"
strWordTemplate = strTemplatePath & "Lipid.dot"
'This date string is used in creating the notes's save name
strShortDate = Format(Date, "m-d-yyyy")
'This date variable is used to print today's date on the note
'(unlike a Word date code, it remains stable when the note is
'reopened later)
dteTodayDate = Date
'Check for existence of template in template folder,
'and exit if not found
strTestFile = Nz(Dir(strWordTemplate))
If strTestFile = "" Then
MsgBox strWordTemplate & " template not found; can't create letter"
Exit Sub
End If
Set objDocs = objWord.Documents
objDocs.Add strWordTemplate
'Write information to Word custom document properties from
'previously created variables.
Set prps = objWord.ActiveDocument.CustomDocumentProperties
prps.Item("NoteDate").Value = dteTodayDate
Debug.Print "Note date = " & dteTodayDate
prps.Item("Name").Value = strName
Debug.Print " Name: " & strName
prps.Item("Age").Value = strAge
Debug.Print "Age: " & strAge
prps.Item("Sex").Value = strSex
Debug.Print "Sex = " & strSex
prps.Item("Diabetes").Value = strDiabetes
Debug.Print "Diabetes = " & strDiabetes
'Highlight the entire Word document and update fields, so the data
'written to the custom doc props is displayed in the DocProperty fields
objWord.Selection.WholeStory
objWord.Selection.Fields.Update
objWord.Selection.HomeKey Unit:=6
objWord.Visible = True
objWord.Activate
'Go to table to fill with Details data.
'I have only one 2x2 table in template; first raw has title;
'I want to start filling data in raws >=2.
'DO I HAVE TO HAVE ANY SPECIAL FORMATTING FOR THIS TABLE?.
With objWord.Selection
.GoTo What:=wdGoToTable, Which:=wdGoToFirst, Count:=1, Name:=""
.MoveDown Unit:=wdLine, Count:=1
End With
Set rst = dbs.OpenRecordset("tqVisits", dbOpenDynaset)
With rst
.MoveFirst
Do While Not .EOF
lngTC = Nz(![TC]) 'TC in tqVisits table made by query; field data
type is Number-Long Integer.
Debug.Print "TC: " & lngTC
lngLDL = Nz(![LDL])
Debug.Print "LDL: " & lngLDL
'Move through the table, writing values from the variables
'to cells in the Word table
With objWord.Selection
.TypeText Text:=lngTC
.MoveRight Unit:=wdCell
.TypeText Text:=lngLDL
.MoveRight Unit:=wdCell
End With
.MoveNext
Loop
.Close
End With
dbs.Close
'Delete last, empty row
Selection.SelectRow
Selection.Rows.Delete
'Check for existence of previously saved letter in documents folder,
'and append an incremented number to save name if found
strSaveName = "Patient " & strName & " on " & strShortDate & ".doc"
intCount = 2
blnSaveNameFail = True
Do While blnSaveNameFail
strSaveNamePath = strDocsPath & strSaveName
Debug.Print "Proposed save name and path: " _
& vbCrLf & strSaveNamePath
strTestFile = Nz(Dir(strSaveNamePath))
If strTestFile = strSaveName Then
'Create new save name with incremented number
blnSaveNameFail = True
strSaveName = "Patient " & CStr(intCount) & _
" on " & strShortDate & ".doc"
strSaveNamePath = strDocsPath & strSaveName
intCount = intCount + 1
Else
blnSaveNameFail = False
End If
Loop
'Ask whether user wants to save the document
'If you prefer, you could eliminate the prompt and just
'save the document with the save name automatically.
strMessageTitle = "Save document?"
strMessage = "Save this document as " & strSaveName
intReturn = MsgBox(strMessage, vbYesNoCancel + _
vbQuestion + vbDefaultButton1, strMessageTitle)
If intReturn = vbNo Then
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
GoTo cmdCreateNote_ClickExit
ElseIf intReturn = vbYes Then
objWord.ActiveDocument.SaveAs strSaveNamePath
ElseIf intReturn = vbCancel Then
GoTo cmdCreateNote_ClickExit
End If
cmdCreateNote_ClickExit:
'Close any open recordset or database, in case code stops because
'of an error
On Error Resume Next
rst.Close
On Error Resume Next
dbs.Close
Exit Sub
cmdCreateNote_ClickErr:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume cmdCreateNote_ClickExit
End Sub
****************************************
The output document would look something like:
Note data:12/23/2007.
Patient PATIENT Name is a 17 year-old M patient who is here for f/u.
Patient has the following medical problems.
Diabetes: Yes, on insulin
Lab Results (table below):
TC / LDL
**********************************************
In the Immediate window I get:
Number of Patients: 1
Age: 17
Sex = M
Diabetes: Yes, on insulin
Docs path: c:\users\myname\documents\
Note date = 12/23/2007
Name: PATIENT Name
Age: 17
Sex = M
Diabetes = Yes, on insulin
*******************************************
word template, and fill data in a word table. I am trying to write a code
adopting a sample code from http://www.helenfeddema.com; column 44. My code
is shown below. The merged file document gets opened with merger of the
fields in the main bulk of the document. However, the word table is not being
filled and I get the following error in access: “Error No: 4120; Description:
Bad parameterâ€. I spent 2 days trying to “fix†this, in vain. I would
appreciate any help.
Code:
*******************************************
Private Sub cmdCreateNote_Click()
Dim dbs As Database
Dim objDocs As Object
Dim objWord As Object
Dim prps As Object
Dim rst As Recordset
Dim blnSaveNameFail As Boolean
Dim dteTodayDate As Date
Dim strName As String
Dim strAge As String
Dim strSex As String
Dim strDiabetes As String
Dim lngTC As Long
Dim lngLDL As Long
Dim strDoc As String
Dim strDocsPath As String
Dim strSaveName As String
Dim strSaveNamePath As String
Dim strShortDate As String
Dim strTemplatePath As String
Dim strWordTemplate As String
Dim strTestFile As String
Dim strTest As String
Dim strMessageTitle As String
Dim strMessage As String
Dim intReturn As Integer
Dim intCount As Integer
'Create a Word instance to use for the invoice; uses the existing Word
'instance if there is one, otherwise creates a new instance
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If Err.Number = 429 Then
'Word is not running; creating a Word object
Set objWord = CreateObject("Word.Application")
Err.Clear
End If
'Sets up error handler for the rest of the procedure
On Error GoTo cmdCreateNote_ClickErr
'Run make-table queries to create tables to use for export.
DoCmd.SetWarnings False
DoCmd.OpenQuery "qHistory"
DoCmd.OpenQuery "qVisit"
DoCmd.SetWarnings True
'Check that there is a patient record filled before creating note.
intCount = DCount("*", "tqHistory")
Debug.Print "Number of Patients: " & intCount
If intCount < 1 Then
MsgBox "No patient selected; cancelling"
Exit Sub
End If
'Create recordset and get needed word document properties for this note.
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tqHistory", dbOpenDynaset)
With rst
'The Nz function is used to convert any Nulls to zeros or
'zero-length strings, to prevent problems with exporting
'to Word.
strName = Nz(![Name])
strAge = Nz(![Age]) 'age was converted to string in the query using
cstr([age]).
Debug.Print "Age: " & strAge
strSex = Nz(![Sex])
Debug.Print "Sex = " & strSex
strDiabetes = Nz(![Diabetes])
Debug.Print "Diabetes: " & strDiabetes
End With
rst.Close
strDocsPath = objWord.Options.DefaultFilePath(wdUserTemplatesPath) & "\"
Debug.Print "Docs path: " & strDocsPath
strTemplatePath = objWord.Options.DefaultFilePath(wdUserTemplatesPath) &
"\"
strWordTemplate = strTemplatePath & "Lipid.dot"
'This date string is used in creating the notes's save name
strShortDate = Format(Date, "m-d-yyyy")
'This date variable is used to print today's date on the note
'(unlike a Word date code, it remains stable when the note is
'reopened later)
dteTodayDate = Date
'Check for existence of template in template folder,
'and exit if not found
strTestFile = Nz(Dir(strWordTemplate))
If strTestFile = "" Then
MsgBox strWordTemplate & " template not found; can't create letter"
Exit Sub
End If
Set objDocs = objWord.Documents
objDocs.Add strWordTemplate
'Write information to Word custom document properties from
'previously created variables.
Set prps = objWord.ActiveDocument.CustomDocumentProperties
prps.Item("NoteDate").Value = dteTodayDate
Debug.Print "Note date = " & dteTodayDate
prps.Item("Name").Value = strName
Debug.Print " Name: " & strName
prps.Item("Age").Value = strAge
Debug.Print "Age: " & strAge
prps.Item("Sex").Value = strSex
Debug.Print "Sex = " & strSex
prps.Item("Diabetes").Value = strDiabetes
Debug.Print "Diabetes = " & strDiabetes
'Highlight the entire Word document and update fields, so the data
'written to the custom doc props is displayed in the DocProperty fields
objWord.Selection.WholeStory
objWord.Selection.Fields.Update
objWord.Selection.HomeKey Unit:=6
objWord.Visible = True
objWord.Activate
'Go to table to fill with Details data.
'I have only one 2x2 table in template; first raw has title;
'I want to start filling data in raws >=2.
'DO I HAVE TO HAVE ANY SPECIAL FORMATTING FOR THIS TABLE?.
With objWord.Selection
.GoTo What:=wdGoToTable, Which:=wdGoToFirst, Count:=1, Name:=""
.MoveDown Unit:=wdLine, Count:=1
End With
Set rst = dbs.OpenRecordset("tqVisits", dbOpenDynaset)
With rst
.MoveFirst
Do While Not .EOF
lngTC = Nz(![TC]) 'TC in tqVisits table made by query; field data
type is Number-Long Integer.
Debug.Print "TC: " & lngTC
lngLDL = Nz(![LDL])
Debug.Print "LDL: " & lngLDL
'Move through the table, writing values from the variables
'to cells in the Word table
With objWord.Selection
.TypeText Text:=lngTC
.MoveRight Unit:=wdCell
.TypeText Text:=lngLDL
.MoveRight Unit:=wdCell
End With
.MoveNext
Loop
.Close
End With
dbs.Close
'Delete last, empty row
Selection.SelectRow
Selection.Rows.Delete
'Check for existence of previously saved letter in documents folder,
'and append an incremented number to save name if found
strSaveName = "Patient " & strName & " on " & strShortDate & ".doc"
intCount = 2
blnSaveNameFail = True
Do While blnSaveNameFail
strSaveNamePath = strDocsPath & strSaveName
Debug.Print "Proposed save name and path: " _
& vbCrLf & strSaveNamePath
strTestFile = Nz(Dir(strSaveNamePath))
If strTestFile = strSaveName Then
'Create new save name with incremented number
blnSaveNameFail = True
strSaveName = "Patient " & CStr(intCount) & _
" on " & strShortDate & ".doc"
strSaveNamePath = strDocsPath & strSaveName
intCount = intCount + 1
Else
blnSaveNameFail = False
End If
Loop
'Ask whether user wants to save the document
'If you prefer, you could eliminate the prompt and just
'save the document with the save name automatically.
strMessageTitle = "Save document?"
strMessage = "Save this document as " & strSaveName
intReturn = MsgBox(strMessage, vbYesNoCancel + _
vbQuestion + vbDefaultButton1, strMessageTitle)
If intReturn = vbNo Then
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
GoTo cmdCreateNote_ClickExit
ElseIf intReturn = vbYes Then
objWord.ActiveDocument.SaveAs strSaveNamePath
ElseIf intReturn = vbCancel Then
GoTo cmdCreateNote_ClickExit
End If
cmdCreateNote_ClickExit:
'Close any open recordset or database, in case code stops because
'of an error
On Error Resume Next
rst.Close
On Error Resume Next
dbs.Close
Exit Sub
cmdCreateNote_ClickErr:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume cmdCreateNote_ClickExit
End Sub
****************************************
The output document would look something like:
Note data:12/23/2007.
Patient PATIENT Name is a 17 year-old M patient who is here for f/u.
Patient has the following medical problems.
Diabetes: Yes, on insulin
Lab Results (table below):
TC / LDL
**********************************************
In the Immediate window I get:
Number of Patients: 1
Age: 17
Sex = M
Diabetes: Yes, on insulin
Docs path: c:\users\myname\documents\
Note date = 12/23/2007
Name: PATIENT Name
Age: 17
Sex = M
Diabetes = Yes, on insulin
*******************************************