Foxtable(狐表)用户栏目专家坐堂 → 复制图片


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

主题:复制图片

帅哥哟,离线,有人找我吗?
裴保民
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:八尾狐 帖子:1989 积分:12631 威望:0 精华:0 注册:2017/4/3 15:01:00
复制图片  发帖心情 Post By:2019/8/21 2:05:00 [显示全部帖子]

怎样将某一行数据中的所有照片复制到指定文件夹中?
例如:数据库中有客户姓名、性别、照片等列,想实现将选中中的客户名下所有的照片复制到以该客户姓名命名的文件夹中,应该创建文件夹再复制照片,怎么实现呢?
[此贴子已经被作者于2019/8/21 7:42:10编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
裴保民
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:八尾狐 帖子:1989 积分:12631 威望:0 精华:0 注册:2017/4/3 15:01:00
  发帖心情 Post By:2019/8/21 9:08:00 [显示全部帖子]

Dim path As String =  ProjectPath & "照片\商户经营照片\"
Dim dr = Tables("商户资料表").Current
Dim str2 As String = ""
Dim Result As DialogResult
If dr Is Nothing Then '如果没找到的话
    MessageBox.Show("数据库中无数据,无效操作!","提示",MessageBoxButtons.OK,MessageBoxIcon.Warning)
    Return
Else
    Dim str1 As String = dr("法人姓名")
    result= MessageBox.Show("是否将此商户下的所有照片资料复制到桌面的《 法人姓名 》文件夹中!", "提示" ,MessageBoxButtons.YesNo,MessageBoxIcon.Question)
    If result = DialogResult.yes Then
        str2 = dr("商户照片原始名称")
        If FileSys.DirectoryExists(path) Then
            For Each file As String In FileSys.GetFiles(path)
                Dim name As String = FileSys.GetName(file)
                If name.Contains(str1) AndAlso name.Contains(str2) Then
                    If FileSys.DirectoryExists("C:\Users\Administrator\Desktop\商户经营照片" ) = False Then
                        FileSys.CreateDirectory("C:\Users\Administrator\Desktop\商户经营照片")
                        If FileSys.DirectoryExists("C:\Users\Administrator\Desktop\商户经营照片\" & str1) = False Then
                            FileSys.CreateDirectory("C:\Users\Administrator\Desktop\商户经营照片\" & str1)
                        End If
                           End If
                     FileSys.CopyFile(file,"C:\Users\Administrator\Desktop\商户经营照片\" & str1 & "\"  & name, True)
                Else
                    MessageBox.Show("此商户无照片数据可复制,操作失败,无效操作!","提示",MessageBoxButtons.OK,MessageBoxIcon.Warning)
                 Return
                End If
            Next
        End If
    End If
End If



经过测试出现如果 ProjectPath & "照片\商户经营照片\" 中照片有两个商户的照片时不复制照片并弹出“此商户无照片数据可复制,操作失败,无效操作!”提醒,如果只有一个商户照的时候能复制,怎么设置一下呢?

 回到顶部
帅哥哟,离线,有人找我吗?
裴保民
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:八尾狐 帖子:1989 积分:12631 威望:0 精华:0 注册:2017/4/3 15:01:00
  发帖心情 Post By:2019/8/21 9:17:00 [显示全部帖子]


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

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



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



[此贴子已经被作者于2019/8/21 9:24:13编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
裴保民
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:八尾狐 帖子:1989 积分:12631 威望:0 精华:0 注册:2017/4/3 15:01:00
  发帖心情 Post By:2019/8/21 10:42:00 [显示全部帖子]

照片命名规则是:法人姓名+商户照片原始名+其他能代表图片意义的特征字符串
每个商户图片名称前半部分是一样的都是法人姓名+商户照片原始名称
图片格式扩展名不是固定的
[此贴子已经被作者于2019/8/21 10:46:47编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
裴保民
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:八尾狐 帖子:1989 积分:12631 威望:0 精华:0 注册:2017/4/3 15:01:00
  发帖心情 Post By:2019/8/21 11:28:00 [显示全部帖子]

图片格式有jpg、png等

 回到顶部
帅哥哟,离线,有人找我吗?
裴保民
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:八尾狐 帖子:1989 积分:12631 威望:0 精华:0 注册:2017/4/3 15:01:00
  发帖心情 Post By:2019/8/21 15:25:00 [显示全部帖子]

FileSys.CopyFile(file,"C:\Users\Administrator\Desktop\商户经营照片\" & str1 & "\"  & name, True)

这句代码是复制这个文件夹里的图片吗?怎么修改成只复制符合条件的数据呢?比如只复制文件名包含某字符串的的图片.

 回到顶部
帅哥哟,离线,有人找我吗?
裴保民
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:八尾狐 帖子:1989 积分:12631 威望:0 精华:0 注册:2017/4/3 15:01:00
  发帖心情 Post By:2019/8/21 16:01:00 [显示全部帖子]

FileSys.CopyFile(file,"C:\Users\Administrator\Desktop\商户经营照片\" & str1 & "\"  & name, True)
这句代码用改吗?怎么只复制一个空文件夹呢?
                 If file.contains(str2) Then
                        FileSys.CopyFile(file ,"C:\Users\Administrator\Desktop\商户经营照片\" & str1 & "\"  & name, True)                   
                    End If


 回到顶部
帅哥哟,离线,有人找我吗?
裴保民
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:八尾狐 帖子:1989 积分:12631 威望:0 精华:0 注册:2017/4/3 15:01:00
  发帖心情 Post By:2019/8/21 16:18:00 [显示全部帖子]

完整的文件名称是
艾涛292417Hzzf1.0系统HBSSJZSCAQZGXWDCSBWG-经营场所 (1).jpg
艾涛292417Hzzf1.0系统HBSSJZSCAQZGXWDCSBWG-收银台.jpg
安雪玲231325HkrtQPOSSJZSAXLSDYSPD-经营门头.jpg


 回到顶部
帅哥哟,离线,有人找我吗?
裴保民
  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:八尾狐 帖子:1989 积分:12631 威望:0 精华:0 注册:2017/4/3 15:01:00
  发帖心情 Post By:2019/8/21 16:37:00 [显示全部帖子]

msgbox(file )
弹出

此主题相关图片如下:111.png
按此在新窗口浏览图片

此主题相关图片如下:22.png
按此在新窗口浏览图片

此主题相关图片如下:微信截图_20190821163430.png
按此在新窗口浏览图片
等信息


msgbox("C:\Users\Administrator\Desktop\商户经营照片\" & str1 & "\"  & name)
没弹出消息框



Dim path As String =  ProjectPath & "照片\商户经营照片\"
Dim dr = Tables("商户资料表").Current
Dim str2 As String = ""
Dim Result As DialogResult
If dr Is Nothing Then '如果没找到的话
    MessageBox.Show("数据库中无数据,无效操作!","提示",MessageBoxButtons.OK,MessageBoxIcon.Warning)
    Return
Else
    Dim str1 As String = dr("法人姓名")
    result= MessageBox.Show("是否将此商户下的所有照片资料复制到桌面的《 法人姓名 》文件夹中!", "提示" ,MessageBoxButtons.YesNo,MessageBoxIcon.Question)
    If result = DialogResult.yes Then
        str2 = str1 & dr("商户照片原始名称")
        If FileSys.DirectoryExists(path) Then
            For Each file As String In FileSys.GetFiles(path)
                Dim name As String = FileSys.GetName(file)
                If name.Contains(str1) Then
                    If FileSys.DirectoryExists("C:\Users\Administrator\Desktop\商户经营照片" ) = False Then
                        FileSys.CreateDirectory("C:\Users\Administrator\Desktop\商户经营照片")
                        If FileSys.DirectoryExists("C:\Users\Administrator\Desktop\商户经营照片\" & str1) = False Then
                            FileSys.CreateDirectory("C:\Users\Administrator\Desktop\商户经营照片\" & str1)
                        End If
                             End If
                         msgbox(file)                                          
                        FileSys.CopyFile(file ,"C:\Users\Administrator\Desktop\商户经营照片\" & str1 & "\"  & name , True)
                       msgbox("C:\Users\Administrator\Desktop\商户经营照片\" & str1 & "\"  & name)
                End If
            Next
        End If
    End If
End If



复制的是整个文件夹的图片,并且不能有其他商户的照片,一旦有就不执行操作

我想实现的是,如果该商户有照片只复制当前商户的照片到桌面上

[此贴子已经被作者于2019/8/21 16:43:56编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
裴保民
  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:八尾狐 帖子:1989 积分:12631 威望:0 精华:0 注册:2017/4/3 15:01:00
  发帖心情 Post By:2019/8/21 16:45:00 [显示全部帖子]

弹出的路径不对吧应该是D盘

应该是第二个对话框弹出的
第一个对话框没弹出消息
[此贴子已经被作者于2019/8/21 16:48:06编辑过]

 回到顶部
总数 11 1 2 下一页