摘要  本文介绍了用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

   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