- Foxtable(狐表) (http://foxtable.net/bbs/index.asp)
-- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2)
---- 历遍指定文件夹下如有相同文件名时，则自动增加01，依此类推 (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=121147)
-- 发布时间：2018/6/30 0:26:00
-- 历遍指定文件夹下如有相同文件名时，则自动增加01，依此类推
老师如题，如文件夹下面已有文件名:AA则新增相同文件名为AA01,如有AA01则新增相同文件名为AA02
下面红色部分如何调整
Dim dr As DataRow = Tables("招标信息.资料明细").Current.DataRow
Dim fdr As DataRow = DataTables("招标信息").Find("项目编号 = \'" & dr("项目编号") & "\'")
Dim pth As String = ProjectPath & "Attachments\\用户工程\\" & fdr("咨询类型") & "\\" & fdr("项目编号") & fdr("项目名称") & "\\招投标资料\\"
Dim nm As String = e.Form.Controls("CmbZLMC").Value
If fdr IsNot Nothing Then
If nm = "" Then
MessageBox.Show("请先输入资料名称!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
Else
Dim dlg As New OpenFileDialog
dlg.Filter = "资料文件|*.doc;*.docx;*.xls;*.xlsx;*.png;*.dwg;*.pdf;*.zip"
If dlg.ShowDialog = DialogResult.OK Then
Dim flnm As String = dlg.FileName
Dim hz As String = flnm.SubString(flnm.LastIndexOf(".")) \'提取文件的后缀名
Dim wjm As String = nm & hz
\'\'==============图像本地保存===============
If FileSys.DirectoryExists(pth) = False Then
FileSys.CreateDirectory(pth)
End If
Dim flt As String = pth & wjm
Dim cnt As Integer = 1
For Each file As String In FileSys.GetFiles(pth)
If file Like "*" & nm & "*" Then
cnt += 1
End If
Next
nm &= "-" & Format(cnt, "00") & hz
FileSys.CopyFile(flnm,flt,True) \'复制文件并重新命名文件名
Dim ndr As Row = Tables("招标信息.资料明细").AddNew()
ndr("资料名称") = wjm \'写入资料文件名称
ndr.Save \'必须先保存
ndr.DataRow.SQLInsertFile("附件",flt) \'插入文件
ndr.DataRow.SQLSetValue("CRC", CRCCheckFile(flt)) \'保存crc检验值
End If
End If
End If
-- 发布时间：2018/6/30 9:06:00
--
Dim cnt As Integer = 1
Dim flt As String = pth & wjm
Do While True
If FileSys.FileExists(flt) Then
flt As String = pth & nm & Format(cnt, "00") & hz
cnt += 1
Else
Exit Do
End If
Loop
-- 发布时间：2018/6/30 14:22:00
--
老师你好：
二进制文件如何直接另在到电脑桌面上，下面代码如何调整？
Dim dlg As New SaveFileDialog \'定义一个新的SaveFileDialog
dlg.Filter= "资料文件|*.doc;*.docx;*.xls;*.xlsx;*.png;*.dwg;*.pdf;*.zip" \'设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮
If Tables("招标信息.资料明细").Current Is Nothing Then
Return
End If
Dim dr As DataRow = Tables("招标信息.资料明细").Current.DataRow
dr.SQLLoadFile("附件",dlg.FileName)
End If
[此贴子已经被作者于2018/6/30 15:16:56编辑过]
-- 发布时间：2018/6/30 16:17:00
--
老师你好：
出现下面二个问题：
1、关联表没有数据时，新增加行，出现错误提示。
2、如下截图，如出现二个“招标公告01”文件，我的需求是不管文件类型，只要文件名称相同，就递增。
此主题相关图片如下：61107.png
| 下载信息 [文件大小： 下载次数： ] | |
 点击浏览该文件:二进制文件名递增.foxdb |
3、为什么数据库上传不了
[此贴子已经被作者于2018/6/30 16:24:33编辑过]
-- 发布时间：2018/6/30 16:35:00
--
1、什么错误提示？
2、可以通过表格查询最大文件名称
Dim flt As String = pth & wjm
Dim dr As DataRow = DataTables("资料明细").compute("max(资料名称)","资料名称 like \'" & nm & "%\'")
If dr IsNot Nothing Then
Dim v = val(dr("资料名称").split(".")(0).replace(nm,"")) + 1
flt = pth & nm & Format(v, "00") & hz
End If
msgbox(flt)
-- 发布时间：2018/6/30 16:41:00
--
老师你好：
二进制文件如何直接另在到电脑桌面上，下面代码如何调整？
Dim dlg As New SaveFileDialog \'定义一个新的SaveFileDialog
dlg.Filter= "资料文件|*.doc;*.docx;*.xls;*.xlsx;*.png;*.dwg;*.pdf;*.zip" \'设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮
If Tables("招标信息.资料明细").Current Is Nothing Then
Return
End If
Dim dr As DataRow = Tables("招标信息.资料明细").Current.DataRow
dr.SQLLoadFile("附件",dlg.FileName)
End If
2、5楼提示错误如下图：
此主题相关图片如下：0164657.png
[此贴子已经被作者于2018/6/30 16:45:06编辑过]
-- 发布时间：2018/6/30 17:15:00
--
错误原因大概是：
1、附件没有数据
2、文件已经存在，无法覆盖
3、保存的路径不存在，或者没有权限写入
-- 发布时间：2018/6/30 17:18:00
--
老师你好：
二进制文件如何直接另在到电脑桌面上，下面代码如何调整？
Dim dlg As New SaveFileDialog \'定义一个新的SaveFileDialog
dlg.Filter= "资料文件|*.doc;*.docx;*.xls;*.xlsx;*.png;*.dwg;*.pdf;*.zip" \'设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮
If Tables("招标信息.资料明细").Current Is Nothing Then
Return
End If
Dim dr As DataRow = Tables("招标信息.资料明细").Current.DataRow
dr.SQLLoadFile("附件",dlg.FileName)
End If
-- 发布时间：2018/6/30 18:00:00
--
代码没有问题，请看7楼
-- 发布时间：2018/6/30 21:03:00
--
老师终于解决了，代码如下：
Dim nm As String = e.Form.Controls("CmbZLMC").Value
Dim ndr As Row = Tables("招标信息.资料明细").AddNew()
If ndr.DataRow.RowState = DataRowState.Added Then \'如果是新增行,必须先保存才能插入文件
ndr.Save()
End If
Dim fdr As DataRow = DataTables("招标信息").Find("项目编号 = \'" & ndr("项目编号") & "\'")
If fdr IsNot Nothing Then
If nm = "" Then
MessageBox.Show("请先输入资料名称!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
Else
Dim dlg As New OpenFileDialog
dlg.Filter = "资料文件|*.doc;*.docx;*.xls;*.xlsx;*.png;*.dwg;*.pdf;*.jpg;*.zip"
If dlg.ShowDialog = DialogResult.OK Then
Dim flnm As String = dlg.FileName
Dim hz As String = flnm.SubString(flnm.LastIndexOf(".")) \'提取文件的后缀名
\'\'==============图像本地保存===============
Dim pth As String = ProjectPath & "Attachments\\用户工程\\" & fdr("咨询类型") & "\\" & fdr("项目编号") & fdr("项目名称") & "\\招投标资料\\"
If FileSys.DirectoryExists(pth) = False Then
FileSys.CreateDirectory(pth)
End If
Dim max As String
Dim idx As Integer
max = Tables("招标信息.资料明细").Compute("Max(资料名称)","资料名称 like \'" & nm & "%\'")
If max > "" Then \'如果存在最大编号
idx = CInt(max.SubString(max.LastIndexOf(".") - 2,2)) + 1
Else
idx = 1 \'否则顺序号等于1
End If
Dim flt As String = pth & nm & Format(idx,"00") & hz \'重新命名文件名
FileSys.CopyFile(flnm,flt,True) \'复制文件并重新命名文件名
ndr("资料名称") = nm & Format(idx,"00") & hz \'写入资料文件名称
ndr.DataRow.SQLInsertFile("附件",flt) \'插入文件
ndr.DataRow.SQLSetValue("CRC", CRCCheckFile(flt)) \'保存crc检验值
End If
End If
End If