merge multiple tables in one word-document: how to do it ?

[svdh2]

I have been looking at a problem the entire week in access, I have
still not been able to find a solution. Hope that you could maybe tell
where to look

Concerns the link between Access and Word. I can not transfer a report
to word without losing out on the lay-out (RTF format). I understand
that there is no way out

ok, mail merge I thought. But here I have the problem that I need to
merge multiple tables and that I can just include one in the mailmerge
within word. A query would seem likely but there I have a problem. I
have one master table containing personal information on staff and 8
subtables around the master table with specifying language, workexp,
education for each person. The number of entries in the subtables
varies per person.

In case I use a query to combine all these tables I get # x # x # x #
x# (9 times) number of records an extreme number of records for each
person.

An example: person A
knows 8 languages
has 3 educational references
10 publications
took 8 courses in his career

This would already result in 1 X 8 X 10 X 8 = 640 records

Do I miss a certain function with queries or how can I work this out? I
can not imagine that it is not possible
Thanks and wishing you a good day

Stefan van den Hark
The Netherlands

[bborden51]

I am very new to Access and VBA but this is how I opened 7 tables using
a command button and control values on a single form and opened a
letter in Word. It opens it in DOC format, not RTF.

Some of this code was copied from other sources on this newsgroup.

I'm sure some of the experts on this newsgroup will have a much easier
way to do the same.

I'm glad I can give a little back to the newsgroup that has helped me
so much.

************************************************** *********
Private Sub cmdConsultPrint_Click()

Dim wrdSelection As Word.Selection
Dim wrdMailMerge As Word.MailMerge
Dim wrdMergeFields As Word.MailMergeFields

Dim StrToAdd As String

If IsNull(Me![cboTitleofCourtesy]) Or IsNull(Me![tboFirstName]) Or
IsNull(Me![tboLastName]) Then
MsgBox "You MUST enter Patient Name and Courtesy Title to
continue!", vbOKOnly
Exit Sub
End If

' Make Referring Doctors table available and select proper record.
If IsNull(Me![cboReferringDoctor]) = False Then

Dim cnn As ADODB.Connection
Dim rst As New ADODB.Recordset
Set cnn = CurrentProject.Connection
rst.ActiveConnection = cnn

rst.Open "SELECT * FROM [tblReferringDoctors]" & _
" WHERE tblReferringDoctors.ReferringDoctorID = " &
Me![cboReferringDoctor]
Else
MsgBox "You MUST enter Referring Doctor to continue!", vbOKOnly
Exit Sub
End If
rst.MoveFirst

' Make Surgeons table available and select proper record.
If IsNull(Me![cboSurgeon]) = False Then

Dim cnn1 As ADODB.Connection
Dim rst1 As New ADODB.Recordset
Set cnn1 = CurrentProject.Connection
rst1.ActiveConnection = cnn1

rst1.Open "SELECT * FROM [tblSurgeons]" & _
" WHERE tblSurgeons.SurgeonID = " & Me![cboSurgeon]
Else
MsgBox "You MUST enter Surgeon to continue!", vbOKOnly
Exit Sub
End If
rst1.MoveFirst

' Make Diagnosis table available and select proper record.
If IsNull(Me![cboDiagnosis]) = False Then

Dim cnn2 As ADODB.Connection
Dim rst2 As New ADODB.Recordset
Set cnn2 = CurrentProject.Connection
rst2.ActiveConnection = cnn2

rst2.Open "SELECT * FROM [tblDiagnosis]" & _
" WHERE tblDiagnosis.DiagnosisID = " & Me![cboDiagnosis]
Else
MsgBox "You MUST enter a Diagnosis to continue!", vbOKOnly
Exit Sub
rst2.MoveFirst
End If
' Make TypeofFlap table available and select proper record.
If IsNull(Me![cboTypeofFlap]) = False Then

Dim cnn3 As ADODB.Connection
Dim rst3 As New ADODB.Recordset
Set cnn3 = CurrentProject.Connection
rst3.ActiveConnection = cnn3

rst3.Open "SELECT * FROM [tblTypeofFlap]" & _
" WHERE tblTypeofFlap.TypeofFlapID = " & Me![cboTypeofFlap]
Else
MsgBox "You MUST enter a Type of Flap to continue!", vbOKOnly
Exit Sub
rst3.MoveFirst
End If

' Make Region table available and select proper record.
If IsNull(Me![cboRegion]) = False Then

Dim cnn4 As ADODB.Connection
Dim rst4 As New ADODB.Recordset
Set cnn4 = CurrentProject.Connection
rst4.ActiveConnection = cnn4

rst4.Open "SELECT * FROM [tblRegion]" & _
" WHERE tblRegion.RegionID = " & Me![cboRegion]
Else
MsgBox "You MUST enter a Site of Tumor to continue!", vbOKOnly
Exit Sub
rst4.MoveFirst
End If

' Make Aspect table available and select proper record.
If IsNull(Me![cboAspect]) = False Then

Dim cnn5 As ADODB.Connection
Dim rst5 As New ADODB.Recordset
Set cnn5 = CurrentProject.Connection
rst5.ActiveConnection = cnn5

rst5.Open "SELECT * FROM [tblAspect]" & _
" WHERE tblAspect.AspectID = " & Me![cboAspect]
Else
MsgBox "You MUST enter a Site Aspect to continue!", vbOKOnly
Exit Sub
rst5.MoveFirst
End If

' Make SurgeryType table available and select proper record.
If IsNull(Me![cboSurgeryType]) = False Then

Dim cnn6 As ADODB.Connection
Dim rst6 As New ADODB.Recordset
Set cnn6 = CurrentProject.Connection
rst6.ActiveConnection = cnn6

rst6.Open "SELECT * FROM [tblSurgeryType]" & _
" WHERE tblSurgeryType.SurgeryTypeID = " & Me![cboSurgeryType]
Else
MsgBox "You MUST enter a Surgery Type to continue!", vbOKOnly
Exit Sub
rst6.MoveFirst
End If

MsgBox "Be sure to REVIEW CONSULTATION LETTER before sending!",
vbOKOnly

' Create an instance of Word, and make it visible.
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True

' Add a new document and uniquely name the document.
Set wrdDoc = wrdApp.Documents.Add
wrdDoc.Select

Set wrdSelection = wrdApp.Selection
Set wrdMailMerge = wrdDoc.MailMerge

' Set left margin.
wrdSelection.ParagraphFormat.LeftIndent = 85

wrdApp.Selection.TypeParagraph
' Left align the line, and insert a date field
' with the current date.

wrdSelection.ParagraphFormat.Alignment = wdAlignParagraphLeft
wrdSelection.InsertDateTime _
DateTimeFormat:="MMMM dd, yyyy", InsertAsField:=False

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

' Print name and address.
StrToAdd = rst.Fields("FirstName")
wrdSelection.TypeText StrToAdd
wrdSelection.TypeText " "
StrToAdd = rst.Fields("LastName")
wrdSelection.TypeText StrToAdd
wrdSelection.TypeParagraph
StrToAdd = rst.Fields("Address")
wrdSelection.TypeText StrToAdd
wrdSelection.TypeParagraph
StrToAdd = rst.Fields("City")
wrdSelection.TypeText StrToAdd
wrdSelection.TypeText ", "
StrToAdd = rst.Fields("State")
wrdSelection.TypeText StrToAdd
wrdSelection.TypeText " "
StrToAdd = rst.Fields("Zip")
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

' Align the rest of the document.
wrdSelection.ParagraphFormat.Alignment = _
wdAlignParagraphJustify

wrdSelection.TypeText "RE: " & Me![tboFirstName] & " " &
Me![tboLastName]

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

wrdSelection.TypeText "Dear " & rst.Fields("FirstName") & ","

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd = " Thank you for allowing me to assist you in the care
of your patient, " & _
Me![cboTitleofCourtesy] & " " & _
Me![tboFirstName] & " " & _
Me![tboLastName] & _
". Today I saw " & _
IIf(Me![cboTitleofCourtesy] <> "Dr.", _
IIf(Me![cboTitleofCourtesy] = "Mr.", "him", "her"), "Dr. " &
Me![tboLastName]) & _
" in consultation for a " & _
rst2.Fields("Diagnosis") & _
", " & _
IIf(IsNull(Me![cboAspect]), "", rst5.Fields("Aspect") & " ") & _
rst4.Fields("Region") & ", with " & _
rst6.Fields("SurgeryType") & _
" scheduled to follow. The risks and benefits were explained to
" & _
IIf(Me![cboTitleofCourtesy] <> "Dr.", _
IIf(Me![cboTitleofCourtesy] = "Mr.", "him", "her"), "Dr. " &
Me![tboLastName]) & _
" and all questions were answered. " & _
Me![cboTitleofCourtesy] & " " & Me![tboLastName] & _
" elected to proceed with the surgery as scheduled under local
anesthesia." & _
" The details of " & _
IIf(Me![cboTitleofCourtesy] <> "Dr.", _
IIf(Me![cboTitleofCourtesy] = "Mr.", "his", "her"), "Dr. " &
Me![tboLastName] & "'s") & _
" surgery are described below."

wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd = " Diagnosis: " & rst2.Fields("Diagnosis")
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd = " Stage: " & Me![tboStage]
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd = " Wound Size: " & Me![tboWoundSize]
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd = " Closure: " & rst3.Fields("TypeofFlap")
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd = " Thank you again for your kind referral." & _
" If I can be of any further assistance to you" & _
" in the care of your patients by providing " & _
rst6.Fields("SurgeryType") & ", please do not hesitate to call."
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd = "Sincerely, "
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd = rst1.Fields("FirstName") & " " & rst1.Fields("LastName") &
", " & rst1.Fields("Credentials")

wrdSelection.TypeText StrToAdd

' Insert pictures
' Call fLoadPictures(Forms!frmPatients!tboPictureFolder)

' Go to the end of the document.
wrdApp.Selection.GoTo wdGoToLine, wdGoToLast

' wrdDoc.SaveAs "C:\SurgeonDatabase\Documents\" &
rst.Fields("LastName") & rst.Fields("FirstName") & _
Me![tboLastName] & "Surgery" & Format(Date, "mmmdyyyy")

' Close the original document.
' wrdDoc.Saved = True
' wrdDoc.Close False

rst.Close
Set rst = Nothing
Set cnn = Nothing

rst1.Close
Set rst1 = Nothing
Set cnn1 = Nothing

Set wrdSelection = Nothing
Set wrdDoc = Nothing
Set wrdApp = Nothing

End Sub

[Bas Cost Budde]

sv***@yahoo.com wrote:

ok, mail merge I thought. But here I have the problem that I need to
merge multiple tables and that I can just include one in the mailmerge
within word. A query would seem likely but there I have a problem. I
have one master table containing personal information on staff and 8
subtables around the master table with specifying language, workexp,
education for each person. The number of entries in the subtables
varies per person. An example: person A
knows 8 languages
has 3 educational references
10 publications
took 8 courses in his career
Maybe a crosstab query (kruistabel) can help you out. Have the person as
row header, the information as column header, and as a value simply an "X".
Do I miss a certain function with queries or how can I work this out? I
can not imagine that it is not possible

An alternative is to search on the net for 'query concatenate' I think
that will point out several solutions where you get, say, the eight
languages (who is this? like to meet the person :-) ) will be in one
field. But that is more complicated so more prone to errors.

Mazzel en als je er in de groep niet uitkomt vanwege taalproblemen kun
je me mailen
--
Bas Cost Budde, Holland
http://www.heuveltop.nl/BasCB/msac_index.html
I prefer human mail above automated so in my address
replace the queue with a tea

[Darryl Kerkeslager]

Just a few miscellaneous notes if you're interested:

1. Put all your Dim statements at the top, where you can find them easier,
and where you can be sure they are in scope wher you need them.

2. Re-use variables, particularly ADO variables, since ADO objects seem to
take longer to create and initialize. You have used several
ADODB.Connection objects, however, they can all be included in one
re-usable:

Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection

3. You don't need the brackets around control names. Your code will be
easier to read if you replace

Me![cboTitleofCourtesy]

with

Me.cboTitleofCourtesy
4. Your ADOBDB.Recordset.Open method will operate faster if you specify all
the available parameters. In fact, using only the default Recordset will
cause problems in many situations.

To open a editable Recordset using an SQL statement:

rst.Open "SELECT * FROM tblReferringDoctors" & _
" WHERE ReferringDoctorID = " &
Me.cboReferringDoctor, cnn, adOpenKeyset, adLockOptimistic,
adCmdText

To open a table for fast, direct table access, but with a forward only
cursor, in read only mode:

rst.Open "tblRegion", cnxn, adOpenForwardOnly, adLockReadOnly,
adCmdTableDirect

5. Use the With/End With construction:

Instead of:

StrToAdd = rst.Fields("FirstName")
wrdSelection.TypeText StrToAdd
wrdSelection.TypeText " "
StrToAdd = rst.Fields("LastName")
wrdSelection.TypeText StrToAdd
wrdSelection.TypeParagraph
StrToAdd = rst.Fields("Address")
wrdSelection.TypeText StrToAdd
wrdSelection.TypeParagraph
StrToAdd = rst.Fields("City")
wrdSelection.TypeText StrToAdd
wrdSelection.TypeText ", "
StrToAdd = rst.Fields("State")
wrdSelection.TypeText StrToAdd
wrdSelection.TypeText " "
StrToAdd = rst.Fields("Zip")
wrdSelection.TypeText StrToAdd
Use:

With wrdSelection
StrToAdd = rst.Fields("FirstName")
.TypeText StrToAdd
.TypeText " "
StrToAdd = rst.Fields("LastName")
.TypeText StrToAdd
.TypeParagraph
StrToAdd = rst.Fields("Address")
.TypeText StrToAdd
.TypeParagraph
StrToAdd = rst.Fields("City")
.TypeText StrToAdd
.TypeText ", "
StrToAdd = rst.Fields("State")
.TypeText StrToAdd
.TypeText " "
StrToAdd = rst.Fields("Zip")
.TypeText StrToAdd
End With

This may run marginally faster and is easier to read
6. Avoid assigning variables when you don't need to. MS examples often
create String variables unnecessarily. Why not just write the above from #5
as:

With wrdSelection
.TypeText rst.Fields("FirstName")
.TypeText " "
.TypeText rst.Fields("LastName")
.TypeParagraph
.TypeText rst.Fields("Address")
.TypeParagraph
.TypeText rst.Fields("City")
.TypeText ", "
.TypeText rst.Fields("State")
.TypeText " "
.TypeText rst.Fields("Zip")
End With
Darryl Kerkeslager
"bb*******@NoSpamgmail.com" <bb*******@gmail.com> wrote: ************************************************** *********
Private Sub cmdConsultPrint_Click()

Dim wrdSelection As Word.Selection
Dim wrdMailMerge As Word.MailMerge
Dim wrdMergeFields As Word.MailMergeFields

Dim StrToAdd As String

If IsNull(Me![cboTitleofCourtesy]) Or IsNull(Me![tboFirstName]) Or
IsNull(Me![tboLastName]) Then
MsgBox "You MUST enter Patient Name and Courtesy Title to
continue!", vbOKOnly
Exit Sub
End If

' Make Referring Doctors table available and select proper record.
If IsNull(Me![cboReferringDoctor]) = False Then

Dim cnn As ADODB.Connection
Dim rst As New ADODB.Recordset
Set cnn = CurrentProject.Connection
rst.ActiveConnection = cnn

rst.Open "SELECT * FROM [tblReferringDoctors]" & _
" WHERE tblReferringDoctors.ReferringDoctorID = " &
Me![cboReferringDoctor]
Else
MsgBox "You MUST enter Referring Doctor to continue!", vbOKOnly
Exit Sub
End If
rst.MoveFirst

' Make Surgeons table available and select proper record.
If IsNull(Me![cboSurgeon]) = False Then

Dim cnn1 As ADODB.Connection
Dim rst1 As New ADODB.Recordset
Set cnn1 = CurrentProject.Connection
rst1.ActiveConnection = cnn1

rst1.Open "SELECT * FROM [tblSurgeons]" & _
" WHERE tblSurgeons.SurgeonID = " & Me![cboSurgeon]
Else
MsgBox "You MUST enter Surgeon to continue!", vbOKOnly
Exit Sub
End If
rst1.MoveFirst

' Make Diagnosis table available and select proper record.
If IsNull(Me![cboDiagnosis]) = False Then

Dim cnn2 As ADODB.Connection
Dim rst2 As New ADODB.Recordset
Set cnn2 = CurrentProject.Connection
rst2.ActiveConnection = cnn2

rst2.Open "SELECT * FROM [tblDiagnosis]" & _
" WHERE tblDiagnosis.DiagnosisID = " & Me![cboDiagnosis]
Else
MsgBox "You MUST enter a Diagnosis to continue!", vbOKOnly
Exit Sub
rst2.MoveFirst
End If
' Make TypeofFlap table available and select proper record.
If IsNull(Me![cboTypeofFlap]) = False Then

Dim cnn3 As ADODB.Connection
Dim rst3 As New ADODB.Recordset
Set cnn3 = CurrentProject.Connection
rst3.ActiveConnection = cnn3

rst3.Open "SELECT * FROM [tblTypeofFlap]" & _
" WHERE tblTypeofFlap.TypeofFlapID = " & Me![cboTypeofFlap]
Else
MsgBox "You MUST enter a Type of Flap to continue!", vbOKOnly
Exit Sub
rst3.MoveFirst
End If

' Make Region table available and select proper record.
If IsNull(Me![cboRegion]) = False Then

Dim cnn4 As ADODB.Connection
Dim rst4 As New ADODB.Recordset
Set cnn4 = CurrentProject.Connection
rst4.ActiveConnection = cnn4

rst4.Open "SELECT * FROM [tblRegion]" & _
" WHERE tblRegion.RegionID = " & Me![cboRegion]
Else
MsgBox "You MUST enter a Site of Tumor to continue!", vbOKOnly
Exit Sub
rst4.MoveFirst
End If

' Make Aspect table available and select proper record.
If IsNull(Me![cboAspect]) = False Then

Dim cnn5 As ADODB.Connection
Dim rst5 As New ADODB.Recordset
Set cnn5 = CurrentProject.Connection
rst5.ActiveConnection = cnn5

rst5.Open "SELECT * FROM [tblAspect]" & _
" WHERE tblAspect.AspectID = " & Me![cboAspect]
Else
MsgBox "You MUST enter a Site Aspect to continue!", vbOKOnly
Exit Sub
rst5.MoveFirst
End If

' Make SurgeryType table available and select proper record.
If IsNull(Me![cboSurgeryType]) = False Then

Dim cnn6 As ADODB.Connection
Dim rst6 As New ADODB.Recordset
Set cnn6 = CurrentProject.Connection
rst6.ActiveConnection = cnn6

rst6.Open "SELECT * FROM [tblSurgeryType]" & _
" WHERE tblSurgeryType.SurgeryTypeID = " & Me![cboSurgeryType]
Else
MsgBox "You MUST enter a Surgery Type to continue!", vbOKOnly
Exit Sub
rst6.MoveFirst
End If

MsgBox "Be sure to REVIEW CONSULTATION LETTER before sending!",
vbOKOnly

' Create an instance of Word, and make it visible.
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True

' Add a new document and uniquely name the document.
Set wrdDoc = wrdApp.Documents.Add
wrdDoc.Select

Set wrdSelection = wrdApp.Selection
Set wrdMailMerge = wrdDoc.MailMerge

' Set left margin.
wrdSelection.ParagraphFormat.LeftIndent = 85

wrdApp.Selection.TypeParagraph
' Left align the line, and insert a date field
' with the current date.

wrdSelection.ParagraphFormat.Alignment = wdAlignParagraphLeft
wrdSelection.InsertDateTime _
DateTimeFormat:="MMMM dd, yyyy", InsertAsField:=False

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

' Print name and address.
StrToAdd = rst.Fields("FirstName")
wrdSelection.TypeText StrToAdd
wrdSelection.TypeText " "
StrToAdd = rst.Fields("LastName")
wrdSelection.TypeText StrToAdd
wrdSelection.TypeParagraph
StrToAdd = rst.Fields("Address")
wrdSelection.TypeText StrToAdd
wrdSelection.TypeParagraph
StrToAdd = rst.Fields("City")
wrdSelection.TypeText StrToAdd
wrdSelection.TypeText ", "
StrToAdd = rst.Fields("State")
wrdSelection.TypeText StrToAdd
wrdSelection.TypeText " "
StrToAdd = rst.Fields("Zip")
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

' Align the rest of the document.
wrdSelection.ParagraphFormat.Alignment = _
wdAlignParagraphJustify

wrdSelection.TypeText "RE: " & Me![tboFirstName] & " " &
Me![tboLastName]

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

wrdSelection.TypeText "Dear " & rst.Fields("FirstName") & ","

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd = " Thank you for allowing me to assist you in the care
of your patient, " & _
Me![cboTitleofCourtesy] & " " & _
Me![tboFirstName] & " " & _
Me![tboLastName] & _
". Today I saw " & _
IIf(Me![cboTitleofCourtesy] <> "Dr.", _
IIf(Me![cboTitleofCourtesy] = "Mr.", "him", "her"), "Dr. " &
Me![tboLastName]) & _
" in consultation for a " & _
rst2.Fields("Diagnosis") & _
", " & _
IIf(IsNull(Me![cboAspect]), "", rst5.Fields("Aspect") & " ") & _
rst4.Fields("Region") & ", with " & _
rst6.Fields("SurgeryType") & _
" scheduled to follow. The risks and benefits were explained to
" & _
IIf(Me![cboTitleofCourtesy] <> "Dr.", _
IIf(Me![cboTitleofCourtesy] = "Mr.", "him", "her"), "Dr. " &
Me![tboLastName]) & _
" and all questions were answered. " & _
Me![cboTitleofCourtesy] & " " & Me![tboLastName] & _
" elected to proceed with the surgery as scheduled under local
anesthesia." & _
" The details of " & _
IIf(Me![cboTitleofCourtesy] <> "Dr.", _
IIf(Me![cboTitleofCourtesy] = "Mr.", "his", "her"), "Dr. " &
Me![tboLastName] & "'s") & _
" surgery are described below."

wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd = " Diagnosis: " & rst2.Fields("Diagnosis")
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd = " Stage: " & Me![tboStage]
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd = " Wound Size: " & Me![tboWoundSize]
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd = " Closure: " & rst3.Fields("TypeofFlap")
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd = " Thank you again for your kind referral." & _
" If I can be of any further assistance to you" & _
" in the care of your patients by providing " & _
rst6.Fields("SurgeryType") & ", please do not hesitate to call."
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd = "Sincerely, "
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd = rst1.Fields("FirstName") & " " & rst1.Fields("LastName") &
", " & rst1.Fields("Credentials")

wrdSelection.TypeText StrToAdd

' Insert pictures
' Call fLoadPictures(Forms!frmPatients!tboPictureFolder)

' Go to the end of the document.
wrdApp.Selection.GoTo wdGoToLine, wdGoToLast

' wrdDoc.SaveAs "C:\SurgeonDatabase\Documents\" &
rst.Fields("LastName") & rst.Fields("FirstName") & _
Me![tboLastName] & "Surgery" & Format(Date, "mmmdyyyy")

' Close the original document.
' wrdDoc.Saved = True
' wrdDoc.Close False

rst.Close
Set rst = Nothing
Set cnn = Nothing

rst1.Close
Set rst1 = Nothing
Set cnn1 = Nothing

Set wrdSelection = Nothing
Set wrdDoc = Nothing
Set wrdApp = Nothing

End Sub