If Tables("收款合同信息.资料明细").Current Is Nothing Then
Return
End If
Dim dr As DataRow = Tables("收款合同信息.资料明细").Current.DataRow
Dim fdr As DataRow = DataTables("收款合同信息").Find("系统编号 = '" & dr("系统编号") & "'")
Dim pth As String = ProjectPath & "Attachments\用户工程\" & fdr("咨询类型") & "\" & fdr("系统编号").SubString(0,4) & fdr("项目名称") & "\合同管理资料\"
If FileSys.DirectoryExists(pth) = False Then
FileSys.CreateDirectory(pth)
End If
Dim fl As String = pth & dr("资料名称")
If FileSys.FileExists(fl) AndAlso CRCCheckFile(fl) = dr.SQLGetValue("CRC") Then '如果本地存在同名文件且CRC校验值相同
'则直接使用本地文件
Else '否则从数据库提取文件
If dr.SQLLoadFile("附件",fl) = False Then '如果提取文件失败
Messagebox.Show("附件提取失败,可能并不存在附件!", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return
End If
End If
Dim app As New MSWord.Application
Try
Dim doc = app.Documents.Open(fl)
app.Documents(fl).ExportAsFixedFormat(fl.SubString(0,fl.LastIndexOf(".")) & ".pdf", MSWord.WdExportFormat.wdExportFormatPDF)
doc.Saved = True
' e.Form.Text = "此会议纪要正在生成中....."
app.Quit
Catch ex As Exception
msgbox(ex.Message)
app.Quit
End Try
MessageBox.Show("Pdf已生成!")
Dim ndr As Row = Tables("收款合同信息.资料明细").AddNew()
If ndr.DataRow.RowState = DataRowState.Added Then '如果是新增行,必须先保存才能插入文件
ndr.Save()
End If
Dim flt As String = dr("资料名称").SubString(0,dr("资料名称").LastIndexOf(".")) & ".pdf"
msgbox(flt)
ndr("资料名称") = flt '写入资料文件名称
msgbox(22)
ndr.DataRow.SQLInsertFile("附件",flt) '插入文件
msgbox(33)
ndr.DataRow.SQLSetValue("CRC", CRCCheckFile(flt)) '保存crc检验值
MessageBox.Show("资料Pdf上传成功!")
此主题相关图片如下：8882808.png
加好友 
发短信
Post By：2018/9/5 20:24:00 [只看该作者]
