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


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

主题:历遍指定文件夹下如有相同文件名时,则自动增加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

 回到顶部
帅哥,在线噢!
有点蓝
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:110582 积分:562806 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By: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

 回到顶部
帅哥哟,离线,有人找我吗?
ZJZK2018
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | 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
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | 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编辑过]

 回到顶部
帅哥,在线噢!
有点蓝
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:110582 积分:562806 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By: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)

 回到顶部
帅哥哟,离线,有人找我吗?
ZJZK2018
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | 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编辑过]

 回到顶部
帅哥,在线噢!
有点蓝
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:110582 积分:562806 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2018/6/30 17:15:00 [只看该作者]

错误原因大概是:

1、附件没有数据
2、文件已经存在,无法覆盖
3、保存的路径不存在,或者没有权限写入

 回到顶部
帅哥哟,离线,有人找我吗?
ZJZK2018
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | 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


 回到顶部
帅哥,在线噢!
有点蓝
  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:110582 积分:562806 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2018/6/30 18:00:00 [只看该作者]

代码没有问题,请看7楼

 回到顶部
帅哥哟,离线,有人找我吗?
ZJZK2018
  10楼 | 信息 | 搜索 | 邮箱 | 主页 | 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

 回到顶部