Foxtable(狐表) → 用户栏目 → 专家坐堂 → 历遍指定文件夹下如有相同文件名时，则自动增加01，依此类推


  共有2448人关注过本帖树形打印复制链接

主题：历遍指定文件夹下如有相同文件名时，则自动增加01，依此类推
帅哥哟，离线，有人找我吗？
ZJZK2018
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：三尾狐 帖子：767 积分：6119 威望：0 精华：0 注册：2018/2/1 17:26:00 		历遍指定文件夹下如有相同文件名时，则自动增加01，依此类推  发帖心情 Post By：2018/6/30 0:26:00 [显示全部帖子]

老师如题，如文件夹下面已有文件名: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
 回到顶部
帅哥哟，离线，有人找我吗？
ZJZK2018
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：三尾狐 帖子：767 积分：6119 威望：0 精华：0 注册：2018/2/1 17:26:00 		  发帖心情 Post By：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编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
ZJZK2018
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：三尾狐 帖子：767 积分：6119 威望：0 精华：0 注册：2018/2/1 17:26:00 		  发帖心情 Post By：2018/6/30 16:17:00 [显示全部帖子]

老师你好：

出现下面二个问题：
1、关联表没有数据时，新增加行，出现错误提示。
2、如下截图，如出现二个“招标公告01”文件，我的需求是不管文件类型，只要文件名称相同，就递增。


图片点击可在新窗口打开查看此主题相关图片如下：61107.png
图片点击可在新窗口打开查看


 下载信息  [文件大小：   下载次数： ]
图片点击可在新窗口打开查看点击浏览该文件:二进制文件名递增.foxdb

 

 3、为什么数据库上传不了

[此贴子已经被作者于2018/6/30 16:24:33编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
ZJZK2018
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：三尾狐 帖子：767 积分：6119 威望：0 精华：0 注册：2018/2/1 17:26:00 		  发帖心情 Post By：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编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
ZJZK2018
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：三尾狐 帖子：767 积分：6119 威望：0 精华：0 注册：2018/2/1 17:26:00 		  发帖心情 Post By：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
 回到顶部
帅哥哟，离线，有人找我吗？
ZJZK2018
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：三尾狐 帖子：767 积分：6119 威望：0 精华：0 注册：2018/2/1 17:26:00 		  发帖心情 Post By：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
 回到顶部
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.05469 秒, 6 次数据查询