前段时间介绍了通过fox操控word直接生成word报表，但是出现了一个问题，字符超过255字时，不能正常，现在通过测试，把fox直接操控word和邮件合并方式相结合可生成word报表，代码分享如下：

\'操控Word文档,主要是文档合并

\'*******************************

\'*********以下代码可修改**********

Dim FileName = "任免审批表.doc"   \'定义模版文件名

Dim Ctn As String = "干部信息"  \'当前表表名,通用格式Functions.Execute("CurrentTableName")

Dim Tb As Table = Tables(Ctn)   \'定义当前表,通用.

\'*********以上代码可修改**********

\'*******************************

on error resume Next

If FileSys.DirectoryExists(ProjectPath & "Reports\\") = False Then   \'如果Reports文件夹不存在

    FileSys.CreateDirectory(ProjectPath & "Reports\\")    \'创建Reports文件夹

End If

Dim App As New MSWord.Application    \'定义MSWord

\'获得模版

FileSys.CopyFile(ProjectPath & "Attachments\\" & FileName, ProjectPath & "Reports\\" & FileName,True)

Dim nDoc = App.Documents.Open(ProjectPath & "Reports\\" & FileName)

Dim rng As MSWord.Range = App.Documents(FileName).Range

rng.Select()   \'全选

rng.Copy()   \'拷贝

nDoc.Activate()

\'插入文段

\'***********************************************

\'*********以下是代码主体部分,需要修改**********

App.Selection.Find.ClearFormatting()

App.Selection.Find.Text = "《姓名》"

App.Selection.Find.Replacement.ClearFormatting()

App.Selection.Find.Replacement.Text = cr("姓名")

App.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)

App.Selection.Find.ClearFormatting()

App.Selection.Find.Text = "《出生年月》"

App.Selection.Find.Replacement.ClearFormatting()

If cr.IsNull("出生年月") = False Then

    App.Selection.Find.Replacement.Text = Format(cr("出生年月"),"yyyy.MM")

Else

    App.Selection.Find.Replacement.Text = ""

End If

App.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)

App.Selection.Find.ClearFormatting()

App.Selection.Find.Text = "《年龄》"

App.Selection.Find.Replacement.ClearFormatting()

If cr.IsNull("年龄") = False Then

    App.Selection.Find.Replacement.Text = Format(cr("年龄"),"0")

Else

    App.Selection.Find.Replacement.Text = ""

End If

App.Selection.Find.Execute(Replace:=MSWord.WdReplace.wdReplaceAll)

rng.Find.ClearFormatting()

If rng.Find.Execute("《照片》") Then

    rng.Select()

    If FileSys.FileExists(ProjectPath & "Attachments\\照片\\" & cr("照片")) Then

        App.Selection.InlineShapes.AddPicture(ProjectPath & "Attachments\\照片\\" & cr("照片"))

    End If

    rng = App.Documents(FileName).Range

    rng.Select()

End If

\'*********以上是代码主体部分,需要修改**********

\'**********************************************

If Tb.Rows.Count > 0 Then

    Dim Book As New XLS.Book(ProjectPath & "Attachments\\Word任免审批表数据源.xls")

    Dim fl As String = ProjectPath & "Reports\\Word任免审批表数据源.xls"

    Book.Build() \'生成细节区

    Book.Save(fl) \'保存工作簿

End If

nDoc.Activate()

nDoc.MailMerge.OpenDataSource(Name:= ProjectPath & "Reports\\Word任免审批表数据源.xls",SQLStatement:="SELECT * FROM `干部信息$`")   \'链接数据源

App.Documents.Open(ProjectPath & "Reports\\" & FileName)   \'再次打开Word模版

nDoc.MailMerge.Execute()

nDoc.Close(False)

以下代码是把Excel 报表和邮件合并相结合的一种方式直接生成word报表 

\'Word邮件合并主要是针对Excel报表数据源设计

\'*******************************

\'*********以下代码可修改**********

Dim FileName = "任免审批表.doc"   \'定义模版文件名

Dim Ctn As String = "干部信息"  \'当前表表名,通用格式Functions.Execute("CurrentTableName")

Dim Tb As Table = Tables(Ctn)   \'定义当前表,通用.

\'*********以上代码可修改**********

\'*******************************

If Tb.Rows.Count > 0 Then

    Dim Book As New XLS.Book(ProjectPath & "Attachments\\Word任免审批表数据源.xls")

    Dim fl As String = ProjectPath & "Reports\\Word任免审批表数据源.xls"

    Book.Build() \'生成细节区

    Book.Save(fl) \'保存工作簿

End If

Dim App As New MSWord.Application    \'定义MSWord

FileSys.CopyFile(ProjectPath & "Attachments\\" & FileName, ProjectPath & "Reports\\" & FileName,True)

Dim nDoc = App.Documents.Open(ProjectPath & "Reports\\" & FileName)   \'定义Word模版

nDoc.Activate()

nDoc.MailMerge.OpenDataSource(Name:= ProjectPath & "Reports\\Word任免审批表数据源.xls",SQLStatement:="SELECT * FROM `干部信息$`")   \'链接数据源，这是最关键的一句，注意标点符号`干部信息$`

App.Documents.Open(ProjectPath & "Reports\\" & FileName)   \'再次打开Word模版

nDoc.MailMerge.Execute()

nDoc.Close(False)

\'*******************************

\'*******************************