VBA、Word和数据库的联合编程

VBA、Word和数据库的联合编程.txt爱情是彩色气球，无论颜色如何严厉，经不起针尖轻轻一刺。一流的爱人，既能让女人爱一辈子，又能一辈子爱一个女人！

VBA、Word和数据库的联合编程

id=content>

src="/mx/baid.js">

id=viewad>

src="/a/lw.js">

摘要

本文介绍了用VBA作为开发语言,用Access或foxpro作为数据库,

用word中的书签作为媒介，实现数据库在Word中的自动替换方法，并以通知书为例给出了源程序。

关键词

VBA

Word

数据库

bookmark(书签)

在实际工作中，常常需要将数据库中的数据放在Word文挡中。例如学校每期都要将学生的成绩填入到通知书中寄发给学生（家庭）。传统的实现方法是在Word手工输入或用数据库软件编写一个专门的程序(模块)来完成此项工作。本文采用VBA作为开发语言,用宏命令的方法实现了Access数据库或foxpro数据库中的数据在Word中的自动成批替换。

1

实现方法

先在Word中建立一个名为“通知书.dot”的模板，将通知书中固定的文字内容输入到该模板中,

将变动的文字内容(取数据库中的字段值)设置成书签(右图中的name、math等)。为了编程方便，书签名可取数据库表中相应的字段名。完成后存入Office的Templates(模板)目录下。

要实现VBA与数据库Microsoft

Access

97的连接,在Word中选主菜单

”工具宏宏名”打开Visual

Basic编辑器；选VBA主菜单条上[工具]菜单项下的[引用]命令，激活[引用]对话框，从可使用的引用列表中选择Microsoft

DAO

2.5/

3.5

Compatibility

Libray一项，然后单击[确定]按钮，把它引用到工程中来。

接下来在模板中编写出一条宏命令，直接在Word中用程序代码实现对数据库的读取。对Access数据库，用语句Set

md

=

DBEngine.

OpenDatabase

(“成绩库.mdb”)打开名为“成绩库.mdb”的数据库，用语句

Set

rs

=

md.

OpenRecordset("学生成绩表",

dbOpenTable)

打开数据库中的表名为"学生成绩表"的记录集，本命令只对记录集进行查询，为了提高查询速度，选择了快照dbOpenSnapShot类型的记录。对于foxpro的dbf数据库,用语句

Set

md

=

OpenDatabase("d:grade学生成绩表",

False,

False,

"foxpro

2.5")打开名为“成绩库.dbf”的数据库，用语句Set

rs

=

md.OpenRecordset("学生成绩表")的记录集。因为数据库中一条记录对应一个学生，每个学生都要打印一份通知书，都要用通知书的内容（包括书签），要将模板中的通知书全部内容复制到一个新建的临时文档中，处理完一条记录后，把通知书内容从新建的临时文挡中复制过来供下一条记录使用。对于每个通知书(对应一条记录)，用循环将数据表中的字段名用数组的形式保存，再根据通知书中的书签名与保存的字段名比较，如果存在则用语句

mydoc1.Bookmarks(i).Select选择的书签名,

用数据表中相应的字段值(rs.Fields(字段名))来替代文档中的所选择的书签名。右图为运行宏命令后的一个通知书。

2

源程序清单

‘从数据题中读取数据的宏,在Word97(2000)上调试运行

‘开发者：湖南工程学院

陈华光

Sub

start()

Dim

i,

j,

k,

m,

nrecord

,

txtnumber

As

Integer

Dim

aname(1

To

20)

As

String

Set

md

=

DBEngine.OpenDatabase("D:grade成绩库.mdb") Set

rs

=

md.OpenRecordset("学生成绩表", dbOpenTable)

Set

mydoc1

=

ActiveDocument

txtnumber

=

mydoc1.Characters.Count

Set

range1

=

mydoc1.Range

(start:=0,

End:=txtnumber)

range1.Copy

mydoc2

=

Documents.Add

Selection.Paste

Set

range2

=

mydoc2.Range(start:=0,

End:=txtnumber)

mydoc1.Activate On

Error

Resume

Next

rs.MoveLast

nrecord

=

rs.RecordCount

On

Error

GoTo

doerror

For

k

=

1

To

20

aname(k)

=

rs.Fields(k).name Next

k

doerror:

For

m

=

1

To

nrecord

If

m

=

1

Then

rs.MoveFirst

Else

rs.MoveNext

For

k

=

1

To

5

VBA、Word和数据库的联合编程(2)

id=content>

src="/mx/baid.js">

id=viewad>

src="/a/lw.js">

totalnumber

=

mydoc1.Bookmarks.Count

'已存在的书签数

For

i

=

totalnumber

To

1

Step

-1

bname

=

rs.Fields(aname(k))

If

UCase$(mydoc1.Bookmarks(i).name) =

UCase$(aname(k))

Then

mydoc1.Bookmarks(i).Select

Selection.TypeText

Text:=bname

End

If

Next

i

Next

k

Selection.MoveDown

Unit:=wdLine,

Count:=4

If

m

<

nrecord

Then

mydoc2.Activate

range2.Copy

mydoc1.Activate

Selection.Paste

End

If

Next

m

Documents(mydoc2).Close savechanges:=wdDoNotSaveChanges End

Sub