亂馬客

前言

最常有些報表可需要用到Word的合併列印，原本想請公司買套Aspose.Word，這樣就不用在Server上裝Office，可是太貴了!只好還是透過Word Automation物件來處理。因為AP蠻常從資料庫讀出資料，然後與範本檔合併列印，所以寫個公用的Method來使用，也分享給大家。

研究

先大約了解一下Word做合併列印的步驟:

1.要先有要合併的檔案
  1.1.先建立功能變數
  1.2.存成範本檔
2.要有資料檔(動態產生)
3.指定範本檔的資料來源檔
4.將合併好的檔案存檔

實作

1.先建立範本檔(Example.doc)

  因為是測試，所以建兩個功能變數(EMP_ID, CNAME)

2.在程式中建立測試的資料(GetMergeData)

''' <summary>
''' 取得要合併的資料
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Private Function GetMergeData() As DataTable
    Dim dtResult As New DataTable("Employee")
    With dtResult.Columns
        .Add("EMP_ID")
        .Add("CNAME")
    End With
    dtResult.Rows.Add(New Object() {"EMP_ID1", "CNAME:亂馬客"})
    dtResult.Rows.Add(New Object() {"EMP_ID2", "CNAME:亂馬客2"})
    Return dtResult
End Function

3.在程式中依資料建立出要合併的資料檔，然後再呼叫Word執行合併列印(MergeWordFile)

''' <summary>
''' 合併列印
''' </summary>
''' <param name="vstrExampleFileName"></param>
''' <param name="vdtData"></param>
''' <param name="vstrDesFileName"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function MergeWordFile(ByVal vstrExampleFileName As String, ByVal vdtData As DataTable, ByVal vstrDesFileName As String) As Boolean
    Dim blnResult As Boolean = False
    Dim wrdApp As Object 'Microsoft.Office.Interop.Word.Application
    Dim wrdDoc As Object 'Microsoft.Office.Interop.Word.Document

    Try
        wrdApp = CreateObject("Word.Application") 'New Microsoft.Office.Interop.Word.Application
        wrdApp.Visible = False
        wrdApp.DisplayAlerts = 0 'Microsoft.Office.Interop.Word.WdAlertLevel.wdAlertsNone
        wrdDoc = wrdApp.Documents.Open(FileName:=vstrExampleFileName, ConfirmConversions:=False, ReadOnly:=False)
        wrdDoc.MailMerge.MainDocumentType = 0 ' Microsoft.Office.Interop.Word.WdMailMergeMainDocType.wdFormLetters
        '準備要合併的Word檔
        Dim wrdDSDoc As Object 'Microsoft.Office.Interop.Word.Document 
        wrdDSDoc = wrdApp.Documents.Add
        wrdDSDoc.Select()
        wrdApp.Selection.WholeStory()
        '建立Title
        Dim strbTitle As New Text.StringBuilder
        For Each dcData As DataColumn In vdtData.Columns
            If strbTitle.Length > 0 Then
                strbTitle.Append(",")
            End If
            strbTitle.Append(dcData.ColumnName)
        Next
        wrdApp.Selection.TypeText(strbTitle.ToString)
        '建立資料列
        For Each drData As DataRow In vdtData.Rows
            Dim strbData As New Text.StringBuilder
            For Each dcData As DataColumn In vdtData.Columns
                If strbData.Length > 0 Then
                    strbData.Append(",")
                End If
                strbData.Append("""" & GetColumnValue(drData, dcData.ColumnName) & """")
            Next
            wrdApp.Selection.TypeParagraph()
            wrdApp.Selection.TypeText(strbData.ToString)

        Next
        Dim strNewDSFile As String = Path.Combine(Path.GetDirectoryName(vstrExampleFileName), Guid.NewGuid.ToString & ".doc")
        wrdDSDoc.SaveAs(strNewDSFile)
        wrdDSDoc.Close(False)
        With wrdDoc.MailMerge
            .OpenDataSource(strNewDSFile)
            .Destination = 0 'Microsoft.Office.Interop.Word.WdMailMergeDestination.wdSendToNewDocument 
            .Execute(False)
        End With
        wrdDoc.Saved = True
        wrdApp.Windows(1).Activate()
        wrdDoc.Close(False)
        wrdApp.ActiveDocument.SaveAs(vstrDesFileName)
        wrdApp.ActiveDocument.Close()
        wrdApp.Quit(False)
        blnResult = True
    Catch ex As Exception
        blnResult = False
        'Throw
        MsgBox(ex.ToString)
    Finally
        If IsNothing(wrdDoc) = False Then
            wrdDoc = Nothing
        End If
        If IsNothing(wrdApp) = False Then
            wrdApp.Quit()
            System.Runtime.InteropServices.Marshal.ReleaseComObject(wrdApp)
            wrdApp = Nothing
        End If
    End Try
    Return blnResult
End Function

4.因為資料有可能會有DBNull，所以直接用GetColumnValue來處理。

''' <summary>
''' 取得欄位值，如果為Null就回傳空字串
''' </summary>
''' <param name="rdrValue"></param>
''' <param name="vColumnName"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Shared Function GetColumnValue(ByRef rdrValue As DataRow, ByVal vColumnName As String) As String
    Return GetColumnValue(rdrValue, vColumnName, "")
End Function

''' <summary>
''' 取得欄位值，如果為Null就回傳預設的參數值
''' </summary>
''' <param name="rdrValue"></param>
''' <param name="vColumnName"></param>
''' <param name="vstrNullDefault"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Shared Function GetColumnValue(ByRef rdrValue As DataRow, ByVal vColumnName As String, ByVal vstrNullDefault As String) As String
    If rdrValue.IsNull(vColumnName) Then
        Return vstrNullDefault
    Else
        Return rdrValue(vColumnName).ToString.Trim
    End If
End Function

5.範例程式說明

本範例會取得範例檔並依資料動態產生資料檔(GUID.doc)，然後將合併後的檔案存到目的檔，如下圖所示。

Private Sub btnMerge_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnMerge.Click
    Dim strAppDirPath As String = Path.GetDirectoryName(Application.ExecutablePath)
    '檔案為執行目錄所在的檔案
    Dim strExampleFile As String = Path.Combine(strAppDirPath, txtExampleFile.Text)
    Dim strDestFile As String = Path.Combine(strAppDirPath, txtDestFile.Text)

    If MergeWordFile(strExampleFile, GetMergeData, strDestFile) = False Then
        MsgBox("合併失敗!")
    Else
        MsgBox("合併成功!")
    End If
End Sub

結論

如果有$的話，真的建議買Aspose的產品。另外，有可能在做Word的合併列印時，會發生”Word 無法啟動轉換程式 mswrd632.wpc”的錯誤!這可能是因為上了MS的Update所造成的! 可以http://support.microsoft.com/kb/973904到修正這個問題哦!

各位如果有更好的方式，也請告訴我! 謝謝!

附上範例程式:WordMailMerge.rar

Hi, 

亂馬客Blog已移到了 「亂馬客​ : Re:從零開始的軟體開發生活」

請大家繼續支持 ^_^