在WORD中访问数据库信息

在WORD中访问数据库信息

以Access为例。在WORD中建立宏myTestAccess。按alt+F8运行宏：myTestAccess

试验环境：Windows XP，Word/Access2000或Word/Access2003

注意：需要在VBA编辑器菜单中选择“工具”—〉“引用”，引入ADO组件（即在Microsoft ActiveX Data Objects前的方框中打上勾号）。

数据库名称：AccessTest.mdb（与本WORD文档在一个目录下）

表名称：Tab1

字段名称：xm、xb、nl、whcd、zzmm（全部都是字符型）

测试数据：用Access打开AccessTest.mdb，自行输入若干条记录

myTestAccess宏的内容：

Sub myTestAccess()

Dim Conn1 As New ADODB.Connection

Dim Rs1 As New ADODB.Recordset

Dim curPath As String

Dim dbPath As String

Dim newdoc As Document

curPath = ActiveDocument.Path

dbPath = curPath

Conn1.Open \"Driver={Microsoft Access Driver (*.mdb)};DBQ=AccessTest.mdb;DefaultDir=\" & dbPath

Set Rs1 = Conn1.Execute(\"select * from tab1\")

Set newdoc = Documents.Add

With newdoc

Selection.TypeText Text:=\"姓 名 性别 年龄文化程度政治面貌\"

While Not Rs1.EOF

Selection.TypeParagraph

Selection.TypeText Text:=Rs1(\"xm\").Value

Selection.TypeText Text:=\" \"

Selection.TypeText Text:=Rs1(\"xb\").Value

Selection.TypeText Text:=\" \"

Selection.TypeText Text:=Rs1(\"nl\").Value

Selection.TypeText Text:=\" \"

Selection.TypeText Text:=Rs1(\"whcd\").Value

Selection.TypeText Text:=\" \"

Selection.TypeText Text:=Rs1(\"zzmm\").Value

Rs1.MoveNext

Wend

Selection.TypeParagraph

Selection.TypeParagraph

Rs1.MoveFirst

ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:=5

Selection.Font.Name = \"黑体\"

Selection.Font.Size = 16

Selection.TypeText Text:=\"姓名\"

Selection.MoveRight Unit:=wdCell

Selection.Font.Name = \"黑体\"

Selection.Font.Size = 16

Selection.TypeText Text:=\"性别\"

Selection.MoveRight Unit:=wdCell

Selection.Font.Name = \"黑体\"

Selection.Font.Size = 16

Selection.TypeText Text:=\"年龄\"

Selection.MoveRight Unit:=wdCell

Selection.Font.Name = \"黑体\"

Selection.Font.Size = 16

Selection.TypeText Text:=\"文化程度\"

Selection.MoveRight Unit:=wdCell

Selection.Font.Name = \"黑体\"

Selection.Font.Size = 16

Selection.TypeText Text:=\"政治面貌\"

While Not Rs1.EOF

Selection.MoveRight Unit:=wdCell

Selection.Font.Name = \"宋体\"

Selection.Font.Size = 12

Selection.TypeText Text:=Rs1(\"xm\").Value

Selection.MoveRight Unit:=wdCell

Selection.Font.Name = \"宋体\"

Selection.Font.Size = 12

Selection.TypeText Text:=Rs1(\"xb\").Value

Selection.MoveRight Unit:=wdCell

Selection.Font.Name = \"宋体\"

Selection.Font.Size = 12

Selection.TypeText Text:=Rs1(\"nl\").Value

Selection.MoveRight Unit:=wdCell

Selection.Font.Name = \"宋体\"

Selection.Font.Size = 12

Selection.TypeText Text:=Rs1(\"whcd\").Value

Selection.MoveRight Unit:=wdCell

Selection.Font.Name = \"宋体\"

Selection.Font.Size = 12

Selection.TypeText Text:=Rs1(\"zzmm\").Value

Rs1.MoveNext

Wend

Selection.MoveDown Unit:=wdLine, Count:=1

Selection.TypeParagraph

ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:=5

Selection.TypeText Text:=\"姓名\"

Selection.MoveRight Unit:=wdCell

Selection.TypeText Text:=\"性别\"

Selection.MoveRight Unit:=wdCell

Selection.TypeText Text:=\"年龄\"

Selection.MoveRight Unit:=wdCell

Selection.TypeText Text:=\"文化程度\"

Selection.MoveRight Unit:=wdCell

Selection.TypeText Text:=\"政治面貌\"

Rs1.MoveFirst

While Not Rs1.EOF

Selection.MoveRight Unit:=wdCell

Selection.TypeText Text:=Rs1(\"xm\").Value

Selection.MoveRight Unit:=wdCell

Selection.TypeText Text:=Rs1(\"xb\").Value

Selection.MoveRight Unit:=wdCell

Selection.TypeText Text:=Rs1(\"nl\").Value

Selection.MoveRight Unit:=wdCell

Selection.TypeText Text:=Rs1(\"whcd\").Value

Selection.MoveRight Unit:=wdCell

Selection.TypeText Text:=Rs1(\"zzmm\").Value

Rs1.MoveNext

Wend

ActiveDocument.Tables(2).Select

Selection.Font.Color = wdColorRed

Selection.Font.Bold = True

Selection.MoveDown Unit:=wdLine, Count:=1

Rs1.Close

Conn1.Close

Set Rs1 = Nothing

Set conn = Nothing

End With

End Sub