Word域与数据库的结合编程-交流共享-唐山网站建设

Word域与数据库的结合编程

核心提示：本文先容了Word域与数据库结合的方法，给用户提供1个插进Word域的界面，并把数据库的数据填充到Word文件中。

本文先容了Word域与数据库结合的方法，给用户提供1个插进Word域的界面，并把数据库的数据填充到Word文件中。

域是Word中最具有实用价值的功能之1，它表示文档中可能产生变化的数据或邮件合并文档中套用信函、标签中的占位符。Microsoft Word 可以在您使用1些特定命令时插进域，如"插进"菜单上的"日期和时间"命令。您也可使用"插进"菜单上的"域"命令手动插进域。事实上，我们在平常工作中常会脱离Microsoft Word的操纵环境。1般，用户是先建立好1些Word文件模板，然后利用所提供的利用程序功能向Word文件模板中插进域，用该域对应的值取代域值，这样就到达了向Microsoft Word文件中插进数据的作用。我们常把数据放进数据库中，数据库的内容不断地变化，我们的域值也随着不断地变化，取到灵活自动更新的作用，要到达这方面的功能，就应当把数据库与Word域结合起来。

解决方法

首先要解决这1题目，我们必须先了解Word域有关的知识：Word域代码位于花括号或大括号 ( { } )中，域类似于 Microsoft Excel 中的公式：域代码类似于公式，域结果（域结果：当 Microsoft Word 履行域指令时，在文档中插进的文字或图形。在打印文档或隐躲域代码时，将以域结果替换域代码。）类似于公式产生的值。可在文档中切换显示域代码及其结果。正好，数据库的字段名对应域代码，字段值对应域值。我们利用VBA编程可以到达目的。VBA for Word 中有关域的类型很多，其中Type:=wdFieldAddin是1种关于字段与字段值对应的特殊域，正是借助它的功能解决题目。我们可以这么假想，用户先打开Word文件，然后向打开的Word文件中插进域，然后用数据库的数据填充。插进域时有2种可能，1种是单值域，即1个域代码对应1个域值（1对1关系），这类情况的域可以插进任何地方；另1种情况是多值域，即1个域代码对应多个域值（1对多关系）。这类情况的域只能插进表格中，并且当表格的行数比域值少时，要能自动提供增加表格行的功能。

实例说明

利用Visual Basic。Net编写通用的类，给用户提供可视化的编辑界面，用于用户在Word文件中插进域标志。针对Word文件或Excel表格文件，扫描全部文件，将其中的域标志取出来，然后通过从数据库中取出字段所对应的值，将值填写到文件中域对应的位置。若对应位置已有值，则判定该值与要填写的值是否是相同，若不同则替换之。插进值分为：

A、单纯的值，直接使用1个值替换域。

B、表格中的单元格。若该表格填写不下，是否是增加表格单元？和与该单元关联的域等。

例如，有2个Access数据库的表（：表1对应单值域，表2对应多值域）以下：

表1：工程

表2：校核

利用VBA编写的1个通用的处理Word域的程序。开发步骤以下：

1、建立项目，向项目中增加处理Word域的类

启动Visual Studio。NET。在新建项目当选择Visual Basic项目，在模板当选择Windows利用程序，把工程名更改成WordDoc。

● 向工程中增加名称为CWordDoc的类。

● 定义的CWordDoc类的属性。代码以下：

以下为援用的内容：
'定义Word利用对象及文档对象
Private wdApp As New Word..Application()
Private wdDoc As New Word.Document()
'所处理的Word模板文件
Private FileName As String
'域的个数及对应的数组
Dim FieldCount As Int16
Dim MyField()
'Word是否是已运行
Private IsWordRunning As Boolean
'是否是已插进了表格行
Private IsInsertRow As Boolean
'Word工具栏对象及菜单栏对象数组
Dim CommandBarIndex() As Integer
Dim SaveCommandBarMenuIndex() As Integer

● 定义的CWordDoc类的方法。

定义打开Word文件的方法。建立Word利用对象和文档对象，并打开Word文件。设定Word已运行。VBA编程主要是先建立某1个利用程序的对象，然后按需要处理利用对象。Word利用对象是“Word.Application”，通过CreateObject方法建立之。代码以下：

以下为援用的内容：
Public Sub OpenWordDocument(ByVal FileName As String)
        wdApp = CreateObject("Word。Application")
        wdApp.Documents。Open(FileName)
        wdDoc = wdApp.ActiveDocument
        wdDoc.ActiveWindow.DocumentMap = False
        wdApp.Visible = True
        IsWordRunning = True
End Sub

保存Word文件。代码以下：

以下为援用的内容：
Public Sub SaveWordDocument()
wdDoc.SaveAs(FileName)
End Sub

定义Word环境的大小。

Word启动后1般是全屏幕（最大化），要把用户操纵界面显示出来，不被Word遮蔽，处理的方法是把用户界面设为顶层窗体，也可使用户界面与Word各自处在自己位置，平行布置。这里是让用户界面位于屏幕的最顶上，Word位于用户界面的下面。因此要重新调剂Word的位置，这需要设置Word窗体状态为普通类型（wdWindowStateNormal）。代码以下：

以下为援用的内容：

Public Sub SetWordSize(ByVal Left As Integer， ByVal top As Integer，
    ByVal width As Integer， ByVal height As Integer)
        wdApp。WindowState = Word.WdWindowState.wdWindowStateNormal
        wdApp。Left = Left
        wdApp。Top = top
        wdApp。Width = width
        wdApp。Height = height
End Sub

这里我们利用Word文档对象中域对象的Add方法向Word文件中插进域。域的Data属性代表该域的名称。插进域时应当选取插进点(Selection)，即用户光标处位置。假设该位置是单元格且已插进域，应当提示是否是覆盖。插进域时要分析是插进单值域还是多值域。根据关键字的后缀辨认，关键字的最后1个字符是'F'时则为多值域。多值域只能插进在表格中。是否是是表格以插进点的单元格辨认。实现该功能的代码以下：

以下为援用的内容：
'在文档中插进域
    'KeyWord:域的关键字
    Public Function InsertField(ByVal KeyWord As String) As Integer
        Dim mySelection As Selection
        Dim Code As String
        Dim MyField As Field
        Dim myRange As Range
        wdApp。Selection。Collapse(Direction:=wdCollapseEnd)
        mySelection = wdApp。Selection      '插进点
        If KeyWord。Chars(KeyWord。Length - 1) = "F" Then
            If IsCell(mySelection) <> True Then
                MsgBox("该位置不是单元格，请选择单元格"， vbOKOnly + vbExclamation)
                Exit Function
            End If
        End If
        If IsCell(mySelection) = True Then
            If CellFieldCount(mySelection) > 0 Then
                If MsgBox("该单元格已有域，是否是覆盖?"， vbYesNo) = 6 Then
                    mySelection.Cells.Item(1).Select()
                    mySelection.Delete()
                Else
                    Exit Function
                End If
            End If
        End If
        MyField = wdDoc.Fields.Add(Range:=mySelection.Range， Type:=wdFieldAddin)
        MyField.Data = KeyWord
    End Function

我们可以通过选择点的表格数判定插进点的性质。表格数为0，则选择点不位于单元格中，反则不位于单元格中。

以下为援用的内容：
'选择点(光标)是否是是单元格。
    Private Function IsCell(ByVal mySelection As Selection) As Boolean
        If mySelection.Tables.Count > 0 Then
            Return True
        Else
            Return False
        End If
    End Function
    '计算选择点(光标)的单元格的域数
    Private Function CellFieldCount(ByVal mySelection As Selection) As Integer
        CellFieldCount = mySelection.Cells.Item(1).Range.Fields.Count
End Function
'记录插进域代码及关键字。这里主要是调用上面的InsertField方法。
    Public Function InsertFieldByKeyWord(ByVal KeyWord As String) As Integer
        Dim ID As Integer
        FieldCount = FieldCount + 1
        ReDim MyField(FieldCount)
        ID = InsertField(KeyWord)
        MyField(FieldCount).ID = ID
        MyField(FieldCount).KeyWord = KeyWord
End Function

当Word文件已插进了域，就要填充域值。填充域值应当分为2种情况考虑。1种是单值域，1种是多值域。单值域是逐1对应关系，仅取出值域插进到对应的位置。实现的方法是扫描全部文档，找出是用户插进的域(Fields.Type = 81)，用域值取代之，这里用到了1个由关键字得到值的方法GetFieldValues，这个方法在后面将会讲到，对应的是数据库的"工程"表。怎样保证永久仅插进1个值呢？方法是先清除掉原域值和域代码，再在当前插进点插进域代码和域值。实现的方法以下：

以下为援用的内容：
'用关键字对应的值插进值，在文档中在有域的地方插进对应的值
    Public Function InsertValue() As Boolean
        Dim i， Count As Integer
        Dim KeyWord As String
        Dim Value， Data
        Dim mySelection As Selection
        Count = wdDoc.Fields.Count
        For i = 1 To Count
            If wdDoc.Fields.Item(i).Type = 81 Then
                KeyWord = wdDoc.Fields.Item(i).Data
                If Right(KeyWord， 1) <> "F" Then
                    Value = clsDB.GetFieldValues("工程"， KeyWord)
                    wdDoc.Fields.Item(i).Select()
                    mySelection = wdApp.Selection      '插进点
                    If mySelection.Tables.Count <> 0 Then
                        'clear text
                        mySelection.Cells.Item(1).Select()
                        mySelection.Delete()
                        '还原原域
                        InsertField(KeyWord)
                    End If
                    wdDoc.Fields.Item(i).Result.Text = Value(0).itemarray(0)
                End If
            End If
        Next
    End Function

插进多值域时要考虑表格行数够不够，不够时要增加表格行数，且每插进1个值，光标要下移1行。这里对应的是数据库的"校核"表。实现的方法以下：

以下为援用的内容：

'插进多值域
    Public Function InsertCollection() As Boolean
        Dim i， j， Count As Integer
        Dim KeyWord As String
        Dim mySelection As Selection
        Dim rec() As Object
        Dim recCount As Integer

        Count = wdDoc.Fields.Count
        For i = 1 To Count
            If wdDoc.Fields.Item(i).Type = 81 Then
                KeyWord = Trim(wdDoc.Fields.Item(i).Data)
                If Right(KeyWord， 1) = "F" Then
                    KeyWord = Left(KeyWord， Len(KeyWord) - 1)
                    rec = clsDB.GetFieldValues("校核"， KeyWord)
                    '选择有域的单元格
                    wdDoc.Fields.Item(i).Select()
                    mySelection = wdApp.Selection      '插进点
                    mySelection.Cells.Item(1).Select()
                    '清除原值
                    mySelection.Delete()
                    '还原原域并更新值
                    InsertField(KeyWord + "F")
                    wdDoc.Fields.Item(i).Result.Text = rec(0).itemarray(0)
                    '光标下移
                    mySelection.Select()
                    mySelection.MoveDown(Unit:=wdLine， Count:=1)
                    With rec
                        recCount =.GetLength(0) - 1
                        For j = 1 To recCount - 1
                            If IsInsertRow = False Then
                                Call InsertRow(mySelection， recCount)
                            End If
                            mySelection.Cells.Item(1).Select()
                            mySelection.Delete()
                            mySelection.TypeText(Text:=rec(j).itemarray(0))
                            mySelection.MoveDown(Unit:=wdLine， Count:=1)
                        Next
                    End With
                End If
            End If
        Next
    End Function
    Private Function InsertRow(ByVal mySelection As Selection，
    ByVal recCount As Integer) As Boolean
        Dim InsertRowCount As Integer           '插进的行数
        Dim CurrCell As Cell
        CurrCell = mySelection.Cells.Item(1)
        InsertRowCount = recCount - mySelection.Tables.Item(1).Rows.Count + 1
        If InsertRowCount > 0 Then
            mySelection.InsertRows(InsertRowCount)
            CurrCell.Select()
            mySelection.MoveUp(Unit:=wdLine， Count:=InsertRowCount)
            IsInsertRow = True
        End If
End Function

假设表格行数少于表数据的行数则应当增加表格行数。增加多少表格行数由表数据的行数减往现有表格行数加进计算出来。当插进了行，光标1定下移了几行，这里要还原光标至原来位置，方法是先保存插进点，插进行后，重新选择插进点，使光标上移几行。表格已插进行以后就不要再插进了，所以致IsInsertRow为真。

以下为援用的内容：
'向表格中增加行数。
    Private Function IsInsert(ByVal mySelection As Selection，
    ByVal recCount As Integer) As Boolean
      Dim InsertRowCount As Integer           '插进的行数
      Dim CurrCell As Cell
      CurrCell = mySelection.Cells.Item(1)
      InsertRowCount = recCount - mySelection.Tables.Item(1).Rows.Count + 1
        If InsertRowCount > 0 Then
            mySelection.InsertRows(InsertRowCount)
            CurrCell.Select()
            mySelection.MoveUp(Unit:=wdLine， Count:=InsertRowCount)
            IsInsertRow = True
        End If
End Function

Word的菜单和工具箱很多，用户操纵时先关掉这些没必要要的东西，最后恢复Word环境的原状。

以下为援用的内容：
'恢复Word环境的所有命令及菜单。
    Public Sub OpenCommandBar()
        Dim i As Integer
        For i = 0 To UBound(CommandBarIndex) - 1
            wdDoc.CommandBars(i + 1).Visible = True
        Next
        For i = 0 To UBound(SaveCommandBarMenuIndex) - 1
            wdDoc.CommandBars.Item("Menu Bar").Controls(i + 1)。Visible = True
        Next
    End Sub
    '封闭Word环境的所有命令及菜单。
    Public Sub CloseCommandBar()
        Dim i As Integer
        Dim cBar
        ReDim CommandBarIndex(1)
        ReDim SaveCommandBarMenuIndex(1)
        i = 0
        For Each cBar In wdDoc.CommandBars
            If cBar.Type = 0 And cBar.Enabled = True Then
                If cBar.Visible = True Then
                    ReDim CommandBarIndex(i + 1)
                    CommandBarIndex(i) = cBar.Index
                    i = i + 1
                    cBar.Visible = False
                End If
            End If
        Next
        i = 0
        For Each cBar In wdDoc.CommandBars("Menu Bar").Controls
            If cBar.Visible = True Then
                ReDim SaveCommandBarMenuIndex(i + 1)
                SaveCommandBarMenuIndex(i) = cBar.Index
                i = i + 1
                cBar.Visible = False
            End If
        Next
End Sub

2、增加1个处理数据库的类COleDataAccess。

COleDataAccess类很简单，包括连接数据库的方法ConnAccess，打开静态表的方法GetDataTable，由字段名得到字段值的方法GetFieldValues。

以下为援用的内容：
Public Class COleDataAccess
Private mOleCnnDB As New OleDbConnection()
'连接Access数据库：DBName数据库名。
    Public Sub ConnAccess(ByVal DBName As String)
        mOleCnnDB.ConnectionString =
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""
";User ID=Admin;" &#38; _
         "Data Source='" &#38; DBName &#38; "'"
      mOleCnnDB.Open()
    End Sub
    '获得数据表.strSql查询条件。
    Public Overloads Function GetDataTable(ByVal strSql As String) As DataTable
        Dim myDataSet As New DataSet()
        Dim myOleDataAdapter As New OleDbDataAdapter()
        myOleDataAdapter.SelectCommand = New OleDbCommand(strSql， mOleCnnDB)
        Try
            myOleDataAdapter.Fill(myDataSet)
        Catch er As Exception
            MsgBox(er.ToString)
        End Try
        Return myDataSet.Tables(0)
    End Function
'由字段名得到字段值的方法:. TableName表名 ; FieldName 字段名
    Public Overloads Function GetFieldValues(ByVal TableName As String，
    ByVal FieldName As String) As Object()
        Dim dr As DataTable
        Dim sql As String
        sql = "select " + FieldName + " from " + TableName
        dr = GetDataTable(sql)
        Dim al(dr.Rows.Count) As Object
        dr.Rows.CopyTo(al， 0)
        Return al
    End Function
End Class

3、增加模块Module1

模块Module1定义COleDataAccess类的变量clsDB，并连接数据库，显示用户窗体。

以下为援用的内容：
Module Module1
    Public clsDB As New COleDataAccess()
    Sub main()
        clsDB.ConnAccess("工程数据。mdb")
        Dim frm As New frmUserWord()
        frm.ShowDialog()
    End Sub
End Module

4、增加用户操纵窗体

向工程中增加1窗体frmUserWord，窗体标题为"处理Word文档"，在frmUserWord上加进3个CommandButton，用于打开文件（cmdOpenFile）、填充数据（cmdFill）、保存文件（cmdSave）用的命令按钮;2个ComboBox，用于所插进的字段名;2个 Label;2个CommonDialog，用于履行打开文件和保存文件;打开文件的对话框OpenFileDialog1、保存文件的对话框SaveFileDialog1。界面以下：

窗体frmUserWord类事实很简单，frmUserWord 类的代码以下：

以下为援用的内容：
Public Class frmUserWord
    Inherits System.Windows.Forms.Form
Dim clsDoc As New CWordDoc()
'打开Word文件。并使处理界面位于Word最顶端，适当调剂Word位置，封闭Word其它功能。
Private Sub cmdOpenFile_Click(ByVal sender As System。Object，
ByVal e As System。EventArgs) Handles cmdOpenFile。Click
        Dim FileName As String
        OpenFileDialog1.ShowDialog()
        FileName = OpenFileDialog1.FileName
        If FileName = "" Then
            Exit Sub
        End If
        clsDoc.OpenWordDocument(FileName)
        clsDoc.SetWordSize(0， 50， 2000， 2000)
       clsDoc.CloseCommandBar()
        Me.Top = 0
        Me.Left = 0
        Me.Width = 10000
        Me.Height = 80
        ComboBox1.Enabled = True
        ComboBox2.Enabled = True
        cmdSave.Enabled = True
        cmdFill.Enabled = True
End Sub

在Form的Load事件中定义打开和保存文件的格式，并填充ComboBox数据。ComboBox数据对应数据库表的字段名。

以下为援用的内容：
Private Sub Form1_Load(ByVal sender As System.Object， ByVal e As
System.EventArgs) Handles MyBase.Load
        Dim i As Integer
        OpenFileDialog1.Title = "打开文件"
        OpenFileDialog1.Filter = "Word文档(*.doc)|*.doc|Word文档模板(*.dot)|*.dot"
        SaveFileDialog1.Title = "保存文件"
        SaveFileDialog1.Filter = "Word文档(*.doc)|*.doc|Word文档模板(*.dot)|*.dot"
        Dim dt As New DataTable()
        dt = clsDB.GetDataTable("select * from 工程")
        For i = 0 To dt.Columns.Count - 1
            ComboBox1.Items.Add(dt.Columns.Item(i).ColumnName)
        Next
        dt = clsDB.GetDataTable("select * from 校核")
        For i = 0 To dt.Columns.Count - 1
            ComboBox2.Items.Add(dt.Columns.Item(i).ColumnName)
        Next
    End Sub
   '填充数据
    Private Sub cmdFill_Click(ByVal sender As System.Object， ByVal e As
System。EventArgs) Handles cmdFill.Click
        clsDoc.InsertValue()
        clsDoc.InsertCollection()
    End Sub
'用户选择所插进域的域名，并在光标处插进单值域。
    Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As Object，
    ByVal e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged
        clsDoc.InsertField(sender.Text)
    End Sub
'用户选择所插进域的域名，并在光标处插进多值域。
域所对应多值时，域只能插进表格中。且要与单值域辨别，标记为多值插进。
    Private Sub ComboBox2_SelectedValueChanged(ByVal sender As Object，
    ByVal e As System.EventArgs) Handles ComboBox2.SelectedValueChanged
        Dim KeyWord As String
        KeyWord = sender.Text + "F" '标记是多值
        clsDoc.InsertField(KeyWord)
    End Sub
'保存Word文件。
    Private Sub cmdSave_Click(ByVal sender As System.Object，
    ByVal e As System.EventArgs) Handles cmdSave.Click
        clsDoc.SaveWordDocument()
End Sub
'打开Word的命令菜单及工具箱。
Private Sub frmUserWord_Closed(ByVal sender As Object，
ByVal e As System.EventArgs) Handles MyBase.Closed
        clsDoc.OpenCommandBar()
    End Sub
End Class

5、利用与测试

1般，此种利用是作为1个软件的1部份，我们可以把它天生组件来用，方法把项目的输出类型改成类库后，把它天生DLL文件便可。这里为了方便测试就直接把它天生利用程序。

下面对它运行时的结果以下：