Dim t As Table = CurrentTable
Dim r As Row = t.Current
Dim tm As String = ProjectPath & "Attachments\报告正文.doc" '指定模板文件
Dim path As String = ProjectPath & "Reports\报告正文\" & r("报告编号") & "\"
If FileSys.DirectoryExists(path) = False Then '如果目录不存在
FileSys.CreateDirectory(path) '则建立
End If
Dim fl As String = path & r("报告编号") & " " & r("样品类别") & " " & r("委托方") & ".doc"
Dim wrt As New WordReport(t,tm,fl) '定义一个WordReport
wrt.Build() '逐行生成报表
wrt.quit
Dim dlg As New OpenFileDialog '定义一个新的OpenFileDialog
dlg.Filter= "Word文件|*.doc" '设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then '如果用户单击了确定按钮
Dim app As New MSWord.Application
try
Dim doc As Object = app.Documents.Open(dlg.FileName)
Dim count = doc.Characters.Count
Dim rng As MSWord.Range = Doc.Range(Start:=0, End:=count)
rng.Select() '全选
rng.Copy() '拷贝
Dim ndoc = app.Documents.Open(fl)
If app.ActiveWindow.Selection.Find.Execute("附页未上传") Then
app.ActiveWindow.Selection.paste
app.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekCurrentPageHeader
app.ActiveWindow.Selection.Font.Size = 9
app.ActiveWindow.Selection.TypeText(Text:= r("报告编号"))
app.ActiveWindow.ActivePane.View.SeekView = MSWord.WdSeekView.wdSeekMainDocument
End If
app.Visible = False
Doc.close
app.Documents.Save
catch ex As exception
msgbox(ex.message)
app.Quit
finally
app.Quit
End try
End If
Dim ftp1 As New FtpClient
ftp1.Host= ""
ftp1.Account = ""
ftp1.Password = ""
If ftp1.DirExists("\报告正文\" & r("报告编号")) = False Then
ftp1.MakeDir("\报告正文\" & r("报告编号"))
End If
Dim tg As String = "\报告正文\" & r("报告编号") & "\" & r("报告编号") & " " & r("样品类别") & " " & r("委托方") & ".doc"
If ftp1.Upload(fl,tg) = True Then
MessageBox.show("上传完成!")
Else
MessageBox.show("上传失败")
End If
加好友 
发短信
Post By：2018/11/23 19:55:00 [只看该作者]
