专家坐堂-二进制文件上传错误提示Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://www.foxtable.com/bbs/index.asp)
--  专家坐堂  (http://www.foxtable.com/bbs/list.asp?boardid=2)
----  二进制文件上传错误提示  (http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=124413)

--  作者：ZJZK2018
--  发布时间：2018/9/5 20:24:00
--  二进制文件上传错误提示
需求：选中关联表中一行，把这一行的文件生成Pdf，我写了下面代码出错：主要错在红色标注部份？谢谢

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

--  作者：有点甜
--  发布时间：2018/9/5 20:28:00
--

msgbox(flt)弹出的是不是绝对路径？对应路径是否有对应文件？

--  作者：ZJZK2018
--  发布时间：2018/9/5 21:06:00
--
文件名和路径搞错了，已好了，谢谢！
但有个问题excel生成Pdf后，打开pdf后乱码？如下图

此主题相关图片如下：222211954.png

[此贴子已经被作者于2018/9/5 21:17:06编辑过]

--  作者：有点甜
--  发布时间：2018/9/5 21:44:00
--

以下是引用ZJZK2018在2018/9/5 21:06:00的发言：
文件名和路径搞错了，已好了，谢谢！
但有个问题excel生成Pdf后，打开pdf后乱码？如下图

[此贴子已经被作者于2018/9/5 21:17:06编辑过]

你如何生成pdf文件的？生成的excel是否正常？

--  作者：ZJZK2018
--  发布时间：2018/9/5 23:53:00
--

选中关联表中一行，把这一行中的二进制文件下载到本地指定文件夹内，再把这文件成Pdf，再上传到数据库中。word文件没有问题，就是excel文件生成PDF出现乱码。

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
If fdr.IsNull("标段名称") Then
pth = ProjectPath & "Attachments\\用户工程\\" & fdr("咨询类型") & "\\" & fdr("系统编号").SubString(0,4) & fdr("项目名称") & "\\合同管理资料\\"
Else
pth = ProjectPath & "Attachments\\用户工程\\" & fdr("咨询类型") & "\\" & fdr("系统编号").SubString(0,4) & fdr("项目名称") & "\\" & fdr("标段名称") & "\\合同管理资料\\"
End If
If FileSys.DirectoryExists(pth) = False Then
FileSys.CreateDirectory(pth)
End If
\'\'======查找word文件========
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
\'\'======生成PDF========
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已生成!")
\'\'========上传PDF=========
Dim ndr As Row = Tables("收款合同信息.资料明细").AddNew()
If ndr.DataRow.RowState = DataRowState.Added Then \'如果是新增行,必须先保存才能插入文件
ndr.Save()
End If

Dim flt As String = fl.SubString(0,fl.LastIndexOf(".")) & ".pdf"
ndr("资料名称") = dr("资料名称").SubString(0,dr("资料名称").LastIndexOf(".")) & ".pdf" \'写入资料文件名称
ndr.DataRow.SQLInsertFile("附件",flt) \'插入文件含路径
ndr.DataRow.SQLSetValue("CRC",CRCCheckFile(flt)) \'保存crc检验值
MessageBox.Show("资料Pdf上传成功!")

[此贴子已经被作者于2018/9/5 23:54:36编辑过]

--  作者：有点甜
--  发布时间：2018/9/6 9:14:00
--

1、首先，对应的excel文件你打开，是否为乱码？是否正常显示？

2、你excel、word用同一段代码？【MSWord.Application】是只能操作word的。

--  作者：ZJZK2018
--  发布时间：2018/9/6 16:54:00
--
老师下面这段代码怎么改？

\'\'======生成PDF========
If dr("资料名称").SubString(dr("资料名称").LastIndexOf(".") + 1).Contains("doc") Then
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
Else
Dim app As New MSExcel.Application
Try
Dim xls = app.Documents.Open(fl)
app.Documents(fl).ExportAsFixedFormat(fl.SubString(0,fl.LastIndexOf(".")) & ".pdf", MSExcel.WdExportFormat.wdExportFormatPDF)
xls.Saved = True
\'e.Form.Text = "此会议纪要正在生成中....."
app.Quit
Catch ex As Exception
msgbox(ex.Message)
app.Quit
End Try
End If

--  作者：有点甜
--  发布时间：2018/9/6 17:06:00
--

excel另存为pdf，参考

Dim App As New MSExcel.Application
try
    Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open("d:\\会议签到表.xls")
    \'创建Excel文件对应的PDF文件
    wb.Saved = True
    wb.ExportAsFixedFormat(MSExcel.XlFixedFormatType.xlTypePDF, "d:\\会议签到表.pdf", MsExcel.XlFixedFormatQuality.xlQualityStandard, True, False, System.Reflection.Missing.Value, System.Reflection.Missing.Value, True, System.Reflection.Missing.Value)
    app.quit
    msgbox("OK")
catch ex As exception
    msgbox(ex.message)
    app.quit
End try

--  作者：客人
--  发布时间：2018/9/12 11:22:00
--
老师你好：
需求是：在生成PDF时做一个进度条，来提醒用户，找不到思路，如何处理？

--  作者：有点甜
--  发布时间：2018/9/12 11:29:00
--

你可以试试这个

http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=123048&skin=0

或者简单一点，你弹出一个提示窗口，生成后，关闭提示窗口