Word域與數據庫的結合編程

本文介紹了Word域與數據庫結合的方法，給用戶提供一個插入Word域的界面，並把數據庫的數據填充到Word文件中。

域是Word中最具有實用價值的功能之一，它表示文檔中可能發生變化的數據或郵件合並文檔中套用信函、標簽中的占位符。Microsoft Word 可以在您使用一些特定命令時插入域，如"插入"菜單上的"日期和時間"命令。您也可使用"插入"菜單上的"域"命令手動插入域。事實上，我們在日常工作中常會脫離Microsoft Word的操作環境。一般，用戶是先建立好一些Word文件模板，然後利用所提供的應用程序功能向Word文件模板中插入域，用該域對應的值取代域值，這樣就達到了向Microsoft Word文件中插入數據的作用。我們常把數據放入數據庫中，數據庫的內容不斷地變化，我們的域值也跟著不斷地變化，取到靈活自動更新的作用，要達到這方面的功能，就應該把數據庫與Word域結合起來。

解決方法

首先要解決這一問題，我們必須先了解Word域有關的知識：Word域代碼位於花括號或大括號 ( { } )中，域類似於 Microsoft Excel 中的公式：域代碼類似於公式，域結果（域結果：當 Microsoft Word 執行域指令時，在文檔中插入的文字或圖形。在打印文檔或隱藏域代碼時，將以域結果替換域代碼。）類似於公式產生的值。可在文檔中切換顯示域代碼及其結果。正好，數據庫的字段名對應域代碼，字段值對應域值。我們利用VBA編程可以達到目的。VBA for Word 中有關域的類型很多，其中Type:=wdFIEldAddin是一種關於字段與字段值對應的特殊域，正是借助它的功能解決問題。我們可以這麼設想，用戶先打開Word文件，然後向打開的Word文件中插入域，然後用數據庫的數據填充。插入域時有二種可能，一種是單值域，即一個域代碼對應一個域值（一對一關系），這種情況的域可以插入任何地方；另一種情況是多值域，即一個域代碼對應多個域值（一對多關系）。這種情況的域只能插入表格中，並且當表格的行數比域值少時，要能自動提供增加表格行的功能。

實例說明

利用Visual Basic。Net編寫通用的類，給用戶提供可視化的編輯界面，用於用戶在Word文件中插入域標志。針對Word文件或Excel表格文件，掃描整個文件，將其中的域標志取出來，然後通過從數據庫中取出字段所對應的值，將值填寫到文件中域對應的位置。若對應位置已有值，則判斷該值與要填寫的值是否相同，若不同則替換之。插入值分為：

A、單純的值，直接使用一個值替換域。

B、表格中的單元格。若該表格填寫不下，是否增加表格單元？以及與該單元關聯的域等。

例如，有二個Access數據庫的表（：表1對應單值域，表2對應多值域）如下：

表1：工程

表2：校核

利用VBA編寫的一個通用的處理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編程主要是先建立某一個應用程序的對象，然後按需要處理應用對象。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啟動後一般是全屏幕（最大化），要把用戶操作界面顯示出來，不被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)，即用戶光標處位置。如果該位置是單元格且已插入域，應該提示是否覆蓋。插入域時要分析是插入單值域還是多值域。根據關鍵字的後綴識別，關鍵字的最後一個字符是'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文件已經插入了域，就要填充域值。填充域值應該分為二種情況考慮。一種是單值域，一種是多值域。單值域是一一對應關系，僅取出值域插入到對應的位置。實現的方法是掃描整個文檔，找出是用戶插入的域(Fields.Type = 81)，用域值取代之，這裡用到了一個由關鍵字得到值的方法GetFIEldValues，這個方法在後面將會講到，對應的是數據庫的"工程"表。怎樣保證永遠僅插入一個值呢？方法是先清除掉原域值和域代碼，再在當前插入點插入域代碼和域值。實現的方法如下：

以下為引用的內容：
'用關鍵字對應的值插入值，在文檔中在有域的地方插入對應的值
    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

插入多值域時要考慮表格行數夠不夠，不夠時要增加表格行數，且每插入一個值，光標要下移一行。這裡對應的是數據庫的"校核"表。實現的方法如下：

以下為引用的內容：

'插入多值域
    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

如果表格行數少於表數據的行數則應該增加表格行數。增加多少表格行數由表數據的行數減去現有表格行數加入計算出來。當插入了行，光標一定下移了幾行，這裡要還原光標至原來位置，方法是先保留插入點，插入行後，重新選擇插入點，使光標上移幾行。表格已經插入行以後就不要再插入了，所以至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、增加一個處理數據庫的類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;" & _
         "Data Source='" & DBName & "'"
      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、增加用戶操作窗體

向工程中增加一窗體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、應用與測試

一般，此種應用是作為一個軟件的一部分，我們可以把它生成組件來用，方法把項目的輸出類型改為類庫後，把它生成DLL文件就可。這裡為了方便測試就直接把它生成應用程序。

下面對它運行時的結果如下：

打開一Word文件運行後的界面如下：

結論

上面方法介紹了Word域的利用，利用VBA編寫Word域的方法。Word域所對應的數據庫的字段的單值和多值的關系，極有普遍性，很有實用價值。