在一个word-document中合并多个表：怎么做？ [英] merge multiple tables in one word-document: how to do it ?

问题描述

我一直在查看整个星期访问的问题，我已经

仍然无法找到解决方案。希望你能告诉

在哪里看看


关注Access和Word之间的联系。我不能将报告转移到word而不会丢失布局（RTF格式）。我明白

没有出路


ok，邮箱合并我想。但是我在这里遇到的问题是我需要将
合并多个表，并且我可以在mailmerge中包含一个

。查询似乎很可能，但我遇到了问题。我有一个主表，其中包含员工的个人信息和8个主表周围的
子表，并指定语言，workexp，

每个人的教育人。子表中的条目数

因人而异。


如果我使用查询来组合所有这些表，我会得到＃x＃x＃x ＃

x＃（9次）记录数量每个

人的极端记录数。


一个例子：人一个

知道8种语言

有3个教育参考

10个出版物

职业生涯中有8门课程/>

这已经导致1 X 8 X 10 X 8 = 640条记录


我是否错过了查询的某项功能或我该如何工作？出来了？我不能想象它是不可能的

谢谢，祝你有个美好的一天


Stefan van den Hark

荷兰

解决方案

我是Access和VBA的新手，但这就是我打开7个表的方法

a命令按钮和控制值在一个表单上，并在Word中打开一个

字母。它以DOC格式打开，而不是RTF。


这些代码中的一些是从这个新闻组的其他来源复制的。


我''我相信这个新闻组的一些专家会有更轻松的方式来做同样的事情。


我很高兴我可以给一点点回到帮助我的新闻组这么多。


******************* ******************************* *********

Private Sub cmdConsultPrint_Click（）


Dim wrdSelection As Word.Selection

Dim wrdMailMerge As Word.MailMerge

Dim wrdMergeFields As Word.MailMergeFields


Dim StrToAdd As String


如果IsNull（我！[cboTitleofCourtesy]）或IsNull（我！[tboFirstName]）或

IsNull（我！[tboLastName]）然后

MsgBox"你必须输入患者姓名和礼貌标题

继续！，vbOKOnly

退出Sub

结束如果


''制作参考文献rs表可用并选择正确的记录。

如果IsNull（我！[cboReferringDoctor]）= False那么


Dim cnn作为ADODB.Connection

Dim rst作为新的ADODB.Recordset

设置cnn = CurrentProject.Connection

rst.ActiveConnection = cnn


rst.OpenSELECT * FROM [tblReferringDoctors]" &安培; _

"在哪里tblReferringDoctors.ReferringDoctorID =" &

Me！[cboReferringDoctor]

Else

MsgBox"你必须输入Refer Doctor继续！，vbOKOnly

退出Sub

结束如果

rst.MoveFirst


''使外科医生表可用并选择正确的记录。

如果IsNull（我！[cboSurgeon]）= False那么


Dim cnn1作为ADODB.Connection

Dim rst1 As新的ADODB.Recordset

设置cnn1 = CurrentProject.Connection

rst1.ActiveConnection = cnn1


rst1.OpenSELECT *来自[tblSurgeons]" &安培; _

"在哪里tblSurgeons.SurgeonID =" &安培;我！[cboSurgeon]

Else

MsgBox"你必须进入外科医生才能继续！，vbOKOnly

退出Sub

结束如果

rst1.MoveFirst


''使诊断表可用并选择正确的记录。

如果是IsNull （我！[cboDiagnosis]）= False然后


Dim cnn2作为ADODB.Connection

Dim rst2作为新的ADODB.Recordset

设置cnn2 = CurrentProject.Connection

rst2.ActiveConnection = cnn2

rst2.OpenSELECT * FROM [tblDiagnosis]" &安培; _

"在哪里tblDiagnosis.DiagnosisID =" &安培;我！[cboDiagnosis]

Else

MsgBox"你必须输入诊断才能继续！，vbOKOnly

退出Sub

rst2.MoveFirst

结束如果

''使TypeofFlap表可用并选择正确的记录。

如果IsNull（我！ [cboTypeofFlap]）= False然后


Dim cnn3作为ADODB.Connection

Dim rst3作为新的ADODB.Recordset

设置cnn3 = CurrentProject.Connection

rst3.ActiveConnection = cnn3

rst3.OpenSELECT * FROM [tblTypeofFlap]" &安培; _

"在哪里tblTypeofFlap.TypeofFlapID =" &安培;我！[cboTypeofFlap]

Else

MsgBox"你必须输入一个Flap才能继续！，vbOKOnly

退出Sub < br $>
rst3.MoveFirst

结束如果


''使地区表可用并选择适当的记录。

如果IsNull（Me！[cboRegion]）= False那么


Dim cnn4作为ADODB.Connection

Dim rst4作为新的ADODB.Recordset

设置cnn4 = CurrentProject.Connection

rst4.ActiveConnection = cnn4

rst4.OpenSELECT * FROM [tblRegion]" &安培; _

"在哪里tblRegion.RegionID =" &安培;我！[cboRegion]

Else

MsgBox"你必须进入肿瘤网站才能继续！，vbOKOnly

退出Sub < br $>
rst4.MoveFirst

结束如果


''使Aspect表可用并选择正确的记录。

如果IsNull（Me！[cboAspect]）= False那么


Dim cnn5作为ADODB.Connection

Dim rst5作为新的ADODB.Recordset

设置cnn5 = CurrentProject.Connection

rst5.ActiveConnection = cnn5

rst5.OpenSELECT * FROM [tblAspect]" &安培; _

"在哪里tblAspect.AspectID =" &安培;我！[cboAspect]

Else

MsgBox"你必须输入一个站点方面继续！，vbOKOnly

退出Sub

rst5.MoveFirst

结束如果


''使SurgeryType表可用并选择正确的记录。

如果IsNull（Me！[cboSurgeryType]）= False那么


Dim cnn6作为ADODB.Connection

Dim rst6作为新的ADODB.Recordset

设置cnn6 = CurrentProject.Connection

rst6.ActiveConnection = cnn6

rst6.OpenSELECT * FROM [tblSurgeryType]" &安培; _

"在哪里tblSurgeryType.SurgeryTypeID =" &安培;我！[cboSurgeryType]

Else

MsgBox"你必须输入手术类型才能继续！，vbOKOnly

退出Sub

rst6.MoveFirst

结束如果


MsgBox"请务必在发送前查看咨询信函！，

vbOKOnly


''创建一个Word实例，并使其可见。

设置wrdApp = CreateObject（" Word.Application"）

wrdApp.Visible = True


''添加一个新文档并对文档进行唯一命名。

设置wrdDoc = wrdApp。 Documents.Add

wrdDoc.Select


设置wrdSelection = wrdApp.Selection

设置wrdMailMerge = wrdDoc.MailMerge


''设置左边距。

wrdSelection.ParagraphFormat.LeftIndent = 85


wrdApp.Selection.TypeParagraph

''左对齐线，并在当前日期插入日期字段

''。


wrdSelection.Pa ragraphFormat.Alignment = wdAlignParagraphLeft

wrdSelection.InsertDateTime _

DateTimeFormat：=" MMMM dd，yyyy"，InsertAsField：= False


wrdApp.Selection.TypeParagraph

wrdApp.Selection.TypeParagraph

wrdApp.Selection.TypeParagraph

wrdApp.Selection.TypeParagraph


''打印姓名和地址。

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（ 城市）

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


''对齐文档的其余部分。

wrdSelection.ParagraphFormat.Alignment = _ < br $>
wdAlignParagraphJustify


wrdSelection.TypeText" RE：" &安培;我！[tboFirstName]& " " &

Me！[tboLastName]


wrdApp.Selection.TypeParagraph

wrdApp.Selection.TypeParagraph


wrdSelection.TypeText" Dear" &安培; rst.Fields（" FirstName"）& "，"


wrdApp.Selection.TypeParagraph

wrdApp.Selection.TypeParagraph


StrToAdd =" ;感谢您允许我帮助您照顾患者的b $ b， &安培; _

我！[cboTitleofCourtesy]& " " &安培; _

我！[tboFirstName]& " " &安培; _

我！[tboLastName]& _

。今天我看到了 &安培; _

IIf（Me！[cboTitleofCourtesy]<>"""，_

IIf（Me！[cboTitleofCourtesy] =" Mr." ，他，她，博士和&

Me！[tboLastName]）& _

"在咨询 &安培; _

rst2.Fields（" Diagnosis"）& _

"，" &安培; _

IIf（IsNull（Me！[cboAspect]），"，"，rst5.Fields（" Aspect"&""）& _

rst4.Fields（" Region"）& ，带有 &安培; _

rst6.Fields（" SurgeryType"）& _

"预定跟随。风险和收益被解释为

&安培; _

IIf（Me！[cboTitleofCourtesy]<>"""，_

IIf（Me！[cboTitleofCourtesy] =" Mr." ，他，她，博士和&

Me！[tboLastName]）& _

"并回答了所有问题。 " &安培; _

我！[cboTitleofCourtesy]& " " &安培;我！[tboLastName]& _

"选择按照当地麻醉的方式进行手术。 &安培; _

"细节 &安培; _

IIf（Me！[cboTitleofCourtesy]<>"""，_

IIf（Me！[cboTitleofCourtesy] =" Mr." ，他的，她，博士和&

Me！[tboLastName]&"'s's"）& _

"手术描述如下。


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 ="诊断： &安培; rst2.Fields（" Diagnosis"）

wrdSelection.TypeText StrToAdd


wrdApp.Selection.TypeParagraph

wrdApp.Selection。 TypeParagraph


StrToAdd ="阶段： &安培;我！[tboStage]

wrdSelection.TypeText StrToAdd


wrdApp.Selection.TypeParagraph

wrdApp.Selection.TypeParagraph

StrToAdd ="伤口大小： &安培;我！[tboWoundSize]

wrdSelection.TypeText StrToAdd


wrdApp.Selection.TypeParagraph

wrdApp.Selection.TypeParagraph

StrToAdd ="关闭： &安培; rst3.Fields（" TypeofFlap"）

wrdSelection.TypeText StrToAdd


wrdApp.Selection.TypeParagraph

wrdApp.Selection。 TypeParagraph

wrdApp.Selection.TypeParagraph


StrToAdd ="再次感谢您的推荐。 &安培; _

"如果我可以为您提供任何进一步的帮助 &安培; _

"通过提供照顾您的患者 &安培; _

rst6.Fields（" SurgeryType"）& 请不要犹豫，打电话。

wrdSelection.TypeText StrToAdd


wrdApp.Selection.TypeParagraph

wrdApp .Selection.TypeParagraph


StrToAdd ="真诚地，&＃;>
wrdSelection.TypeText StrToAdd


wrdApp。 Selection.TypeParagraph

wrdApp.Selection.TypeParagraph

wrdApp.Selection.TypeParagraph


StrToAdd = rst1.Fields（" FirstName" ;）& " " &安培; rst1.Fields（" LastName"）&

"，" &安培; rst1.Fields（凭证）


wrdSelection.TypeText StrToAdd


''插入图片

' '调用fLoadPictures（Forms！frmPatients！tboPictureFolder）


''转到文档末尾。

wrdApp.Selection.GoTo wdGoToLine，wdGoToLast


''wrdDoc.SaveAs" C：\ SurgeonDatabase \Documents \" &

rst.Fields（" LastName"）& rst.Fields（" FirstName"）& _

我！[tboLastName]& "外科手术" &安培;格式（日期，mmmdyyyy）


''关闭原始文件。

''wrdDoc.Saved = True

''wrdDoc.Close False


rst.Close

Set rst = Nothing

设置cnn = Nothing


rst1.Close

Set rst1 = Nothing

设置cnn1 = Nothing


设置wrdSelection =没什么

设置wrdDoc =没什么

设置wrdApp =没什么


结束子

sv***@yahoo.com 写道：

好吧，邮件合并我想。但是我在这里遇到的问题是我需要合并多个表，并且我可以在mailmerge中包含一个
。查询似乎很可能，但我遇到了问题。我有一个主表，其中包含员工的个人信息和主表周围的8个子表，并为每个人指定语言，workexp，
教育。子表中的条目数
因人而异。
一个例子：人A
知道8种语言
有3个教育参考
10个出版物
他的职业生涯中有8个课程


也许交叉表查询（kruistabel）可以帮助你。将此人称为

行标题，将信息作为列标题，并将值简单地称为X。

我是否错过了查询或某些功能我可以解决这个问题吗？我无法想象它是不可能的

另一种方法是在网上搜索''查询连接''我认为

将指出几种解决方案，比如你得到的八种语言（这是谁？喜欢见人:-)）将在一个

字段。但这更复杂，更容易出错。


Mazzel en als je de in groep niet uitkomt vanwege taalproblemen kun

je me mailen
-

Bas Cost Budde，荷兰
http://www.heuveltop.nl/BasCB/msac_index.html

我更喜欢人工邮件高于自动化，所以在我的地址中

用茶替换队列

如果你感兴趣的话，只需要几个杂项说明：


1.全部放入您可以在顶部找到昏暗的陈述，在那里您可以更轻松地找到它们，

以及您可以确定它们在您需要的范围内。


2重用变量，特别是ADO变量，因为ADO对象似乎需要更长的时间来创建和初始化。你已经使用了几个

ADODB.Connection对象，但是，它们都可以包含在一个

中可重复使用：


Dim cnn As ADODB.Connection

设置cnn = CurrentProject.Connection


3.你不需要控制名称旁边的括号。你的代码将是

如果你更换更容易阅读


我！[cboTitleofCourtesy]


与


Me.cboTitleofCourtesy

4.如果指定可用参数的所有

，则ADOBDB.Recordset.Open方法将运行得更快。事实上，在许多情况下，仅使用默认的Recordset将导致问题。


使用SQL语句打开可编辑的Recordset：


rst.OpenSELECT * FROM tblReferringDoctors" &安培; _

" WHERE ReferDoctorID =" &

Me.cboReferringDoctor，cnn，adOpenKeyset，adLockOptimistic，

adCmdText


打开快速直接表的表在只读模式下访问，但只有前向

光标：


rst.Open" tblRegion"，cnxn，adOpenForwardOnly，adLockReadOnly，

adCmdTableDirect


5.使用With / End With构造：


而不是：

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


使用：


使用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

结束


这可能会略微加快并且更容易阅读

6.避免在不需要时分配变量。 MS示例经常

不必要地创建String变量。为什么不从＃5

写上面的内容：


使用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"）

结束时

Darryl Kerkeslager

" ; BB ******* @ NoSpamgmail.com" < BB ******* @ gmail.com>写道：************************************************ ** *********
Private Sub cmdConsultPrint_Click（）

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

Dim StrToAdd As String

如果IsNull（我！[cboTitleofCourtesy]）或IsNull（我！[tboFirstName]）或
IsNull（我！[tboLastName]）然后
MsgBox你必须输入患者姓名和礼貌标题才能继续！，vbOKOnly
退出Sub
结束如果

''使用引用医生表并选择正确的记录。
如果IsNull（我！[cboReferringDoctor]）= False那么

Dim cnn作为ADODB.Connection
Dim rst作为新的ADODB.Recordset
设置cnn = CurrentProject.Connection
rst.ActiveConnection = cnn

rst.OpenSELECT * FROM [tblReferringDoctors]" &安培; _
在哪里tblReferringDoctors.ReferringDoctorID =" &
我！[cboReferringDoctor]
其他
MsgBox你必须进入转诊医生才能继续！，vbOKOnly
退出Sub
结束如果 rst.MoveFirst

''提供外科医生表并选择适当的记录。
如果IsNull（我！[cboSurgeon]）= False那么

Dim cnn1 As ADODB.Connection
Dim rst1作为新的ADODB.Recordset
设置cnn1 = CurrentProject.Connection
rst1.ActiveConnection = cnn1

rst1.OpenSELECT * FROM [ tblSurgeons] QUOT; &安培; _
在哪里tblSurgeons.SurgeonID =" &安培;我！[cboSurgeon]
其他
MsgBox你必须进入外科医生才能继续！，vbOKOnly
退出Sub
结束如果
rst1.MoveFirst
>
''使诊断表可用并选择适当的记录。
如果IsNull（我！[cboDiagnosis]）= False那么

Dim cnn2作为ADODB.Connection
Dim rst2作为新的ADODB.Recordset
设置cnn2 = CurrentProject.Connection
rst2.ActiveConnection = cnn2

rst2.OpenSELECT * FROM [tblDiagnosis]" &安培; _
在哪里tblDiagnosis.DiagnosisID =" &安培;我！[cboDiagnosis]
其他
MsgBox你必须输入诊断才能继续！，vbOKOnly
退出Sub
rst2.MoveFirst
结束如果

''使TypeofFlap表可用并选择正确的记录。
如果IsNull（Me！[cboTypeofFlap]）= False那么

Dim cnn3作为ADODB.Connection Dim rst3作为新的ADODB.Recordset
设置cnn3 = CurrentProject.Connection
rst3.ActiveConnection = cnn3

rst3.OpenSELECT * FROM [tblTypeofFlap]" &安培; _
在哪里tblTypeofFlap.TypeofFlapID =" &安培;我！[cboTypeofFlap]
其他
MsgBox你必须输入一种挡板才能继续！，vbOKOnly
退出Sub
rst3.MoveFirst
结束If

''使区域表可用并选择正确的记录。
如果IsNull（我！[cboRegion]）= False那么

Dim cnn4 As ADODB.Connection
Dim rst4作为新的ADODB.Recordset
设置cnn4 = CurrentProject.Connection
rst4.ActiveConnection = cnn4
rst4。打开SELECT * FROM [tblRegion]" &安培; _
在哪里tblRegion.RegionID =" &安培;我！[cboRegion]
其他
MsgBox你必须进入一个肿瘤网站才能继续！，vbOKOnly
退出Sub
rst4.MoveFirst
结束If

''使Aspect表可用并选择正确的记录。
如果IsNull（我！[cboAspect]）= False那么

Dim cnn5作为ADODB.Connection
Dim rst5作为新的ADODB.Recordset
设置cnn5 = CurrentProject.Connection
rst5.ActiveConnection = cnn5
rst5.OpenSELECT * FROM [tblAspect]" &安培; _
在哪里tblAspect.AspectID =" &安培;我！[cboAspect]
其他
MsgBox你必须进入一个站点方面继续！，vbOKOnly
退出Sub
rst5.MoveFirst
结束如果

''使SurgeryType表可用并选择正确的记录。
如果IsNull（Me！[cboSurgeryType]）= False那么

Dim cnn6作为ADODB.Connection
Dim rst6作为新的ADODB.Recordset
设置cnn6 = CurrentProject.Connection
rst6.ActiveConnection = cnn6
rst6.OpenSELECT * FROM [tblSurgeryType]" &安培; _
在哪里tblSurgeryType.SurgeryTypeID =" &安培;我！[cboSurgeryType]
其他
MsgBox你必须输入手术类型继续！，vbOKOnly
退出Sub
rst6.MoveFirst
结束如果< msgBox请务必在发送之前查看咨询信函！，
vbOKOnly

''创建一个Word实例，并使其可见。
设置wrdApp = CreateObject（" Word.Application"）
wrdApp.Visible = True

''添加一个新文档并唯一命名文档。
设置wrdDoc = wrdApp.Documents.Add
wrdDoc.Select

设置wrdSelection = wrdApp.Selection
设置wrdMailMerge = wrdDoc.MailMerge

''设置左边距。
wrdSelection.ParagraphFormat.LeftIndent = 85

wrdApp.Selection.TypeParagraph

''左对齐线，并插入日期字段
''当前日期。

wrdSelection.ParagraphFormat.Alignment = wdAlignParagraphLeft
wrdSelection.InsertDateTime _
DateTimeFormat：=& MMMM dd，yyyy"，InsertAsField：= False

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

''打印名称和地址。
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
''对齐文档的其余部分。
wrdSelection.ParagraphFormat.Alignment = _
wdAlignParagraphJustify

wrdSelection.TypeText" RE：" &安培;我！[tboFirstName]& " " &
我！[tboLastName]

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

wrdSelection.TypeText" Dear" &安培; rst.Fields（" FirstName"）& "，"

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd ="感谢您允许我帮助您照顾您的患者， &安培; _
我！[cboTitleofCourtesy]& " " &安培; _
我！[tboFirstName]& " " &安培; _
我！[tboLastName]& _
今天我看到了 &安培; IIf（Me！[cboTitleofCourtesy]<>" Dr."，_
IIf（Me！[cboTitleofCourtesy] =" Mr."，him，她的，博士和我！[tboLastName]）& _
在咨询 &安培; _
rst2.Fields（" Diagnosis"）& _
"，" &安培; IIf（IsNull（Me！[cboAspect]），"，rst5.Fields（" Aspect"&""）& _
rst4.Fields（" Region"）& ，带有 &安培; _
rst6.Fields（" SurgeryType"）& _
预定跟随。风险和利益被解释为
&安培; IIf（Me！[cboTitleofCourtesy]<>" Dr."，_
IIf（Me！[cboTitleofCourtesy] =" Mr."，him，她的，博士和我！[tboLastName]）& _
并回答了所有问题。 " &安培; _
我！[cboTitleofCourtesy]& " " &安培;我！[tboLastName]& _
选择在当地麻醉下按计划进行手术。 &安培; _
细节 &安培; IIf（Me！[cboTitleofCourtesy]<>" Dr."，_
IIf（Me！[cboTitleofCourtesy] =" Mr."，his，她的，博士和我！[tboLastName]&"'s"）& _
手术描述如下。

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 ="诊断： &安培; rst2.Fields（" Diagnosis"）
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd =" ;阶段： &安培;我！[tboStage]
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd ="伤口大小： &安培;我！[tboWoundSize]
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd ="关闭： &安培; rst3.Fields（" TypeofFlap"）
wrdSelection.TypeText StrToAdd

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

StrToAdd ="再次感谢您的推荐。 &安培; _
如果我可以为您提供任何进一步的帮助 &安培; _
通过提供照顾您的患者 &安培; _
rst6.Fields（" SurgeryType"）& 请不要犹豫，打电话。
wrdSelection.TypeText StrToAdd

wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeParagraph

StrToAdd ="真诚地，&＃;> 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

''插入图片
''调用fLoadPictures（Forms！frmPatients！tboPictureFolder）

''转到文档的末尾。
wrdApp.Selection.GoTo wdGoToLine，wdGoToLast

''wrdDoc.SaveAs" C：\ SurgeonDatabase \ Documents\" &
rst.Fields（" LastName"）& rst.Fields（" FirstName"）& _
我！[tboLastName]& "外科手术" &安培; 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

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

解决方案

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

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

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

这篇关于在一个word-document中合并多个表：怎么做？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！