前段时间介绍了通过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)
[此贴子已经被作者于2013-9-14 16:20:31编辑过]
加好友 
发短信
Post By：2013/9/14 16:19:00 [只看该作者]
