Foxtable(狐表) → 用户栏目 → 专家坐堂 → 怎么从excel 里面提取每张图片


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

主题：怎么从excel 里面提取每张图片
帅哥哟，离线，有人找我吗？
繁羽
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：幼狐 帖子：84 积分：512 威望：0 精华：0 注册：2021/11/30 17:01:00 		怎么从excel 里面提取每张图片  发帖心情 Post By：2021/12/27 11:02:00 [显示全部帖子]

Dim dlg As New OpenFileDialog '定义一个新的OpenFileDialog
dlg.Filter= "Excel文件|*.xlsx|Word文件|*.doc|Access文件|*.mdb" '设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then '如果用户单击了确定按钮
    Dim nms() As String = {"状态","记录时间","店铺名称","产品类别","单号","产品SKU","责任方","状况描述 原因","客户姓名","联系方式","寄送地址","处理方式","寄送SKU","配件SKU","数量","备注","发货仓库","系统单号","追踪号","物流公司","发货日期","收货日期","下单日期","回访","记录日期","结束日期","赠送SKU","处理时间"}
    Dim nms2() As String = {"状态","记录时间","店铺名称","产品类别","单号z","产品SKU","责任方","状况描述 原因","客户姓名","联系方式","寄送地址","处理方式","寄送SKU","配件SKU","数量","备注","发货仓库","系统单号","追踪号","物流公司","发货日期","收货日期","下单日期","回访","记录日期","结束日期","赠送SKU","处理时间"}
    Dim dict As new Dictionary(of String,String)
    For m As Integer = 0 To nms.Length - 1
        dict.add(nms2(m),nms(m))
    Next
    Dim Book As New XLS.Book(dlg.FileName)
    Dim Sheet As XLS.Sheet = Book.Sheets(0)
    Tables("table_3").StopRedraw()
    '注意下面的循环变量从1开始,而不是从0开始,因为Excel表的第一行是标题
    For n As Integer = 1 To Sheet.Rows.Count -1
        Dim bh As String = sheet(n,3).Text
        If DataTables("table_3").Find("单号 = '"& bh &"'")Is Nothing Then
            If  Sheet(n,0).text > "" Then
                Dim r As Row = Tables("table_3").AddNew()
                For m1 As Integer = 0 To Sheet.Cols.Count - 1
                    If dict.ContainsKey(Sheet(0,m1).Value)
                        r(dict(Sheet(0,m1).Value)) = Sheet(n,m1).Value
                    End If
                Next
                r("处理人") = user.name
                r("记录")=Datetime.Today & "批量导入"
                r("状态")="已结案"
            End If
        End If
    Next
    Tables("table_3").ResumeRedraw()
    msgbox("导入成功")
End If
老师您好，我想导入图片，我想问一下如何导入图片进foxtable里面，我想提取每一个行的图片用ftp上传到服务器里面
 回到顶部
帅哥哟，离线，有人找我吗？
繁羽
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：幼狐 帖子：84 积分：512 威望：0 精华：0 注册：2021/11/30 17:01:00 		  发帖心情 Post By：2021/12/27 11:45:00 [显示全部帖子]

老师我不是报表导入的喔，我是excel图片如何提出来

 回到顶部
帅哥哟，离线，有人找我吗？
繁羽
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：幼狐 帖子：84 积分：512 威望：0 精华：0 注册：2021/11/30 17:01:00 		  发帖心情 Post By：2021/12/27 11:56:00 [显示全部帖子]

If Sheet(4,4).SaveImage(fl) Then '如果照片保存成功
            dr("照片") = fileSys.GetName(fl) ，是这个吗老师我想问一下这个4，4是什么意思

 回到顶部
帅哥哟，离线，有人找我吗？
繁羽
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：幼狐 帖子：84 积分：512 威望：0 精华：0 注册：2021/11/30 17:01:00 		  发帖心情 Post By：2021/12/27 13:04:00 [显示全部帖子]

Dim dlg As New OpenFileDialog '定义一个新的OpenFileDialog
dlg.Filter= "Excel文件|*.xlsx|Word文件|*.doc|Access文件|*.mdb" '设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then '如果用户单击了确定按钮
    Dim nms() As String = {"状态","记录时间","店铺名称","产品类别","单号","产品SKU","责任方","状况描述 原因","客户姓名","联系方式","寄送地址","处理方式","寄送SKU","配件SKU","数量","备注","发货仓库","系统单号","追踪号","物流公司","发货日期","收货日期","下单日期","回访","记录日期","结束日期","赠送SKU","处理时间"}
    Dim nms2() As String = {"状态","记录时间","店铺名称","产品类别","单号z","产品SKU","责任方","状况描述 原因","客户姓名","联系方式","寄送地址","处理方式","寄送SKU","配件SKU","数量","备注","发货仓库","系统单号","追踪号","物流公司","发货日期","收货日期","下单日期","回访","记录日期","结束日期","赠送SKU","处理时间"}
    Dim dict As new Dictionary(of String,String)
    For m As Integer = 0 To nms.Length - 1
        dict.add(nms2(m),nms(m))
    Next
    Dim Book As New XLS.Book(dlg.FileName)
    Dim Sheet As XLS.Sheet = Book.Sheets(0)
    Tables("table_3").StopRedraw()
    '注意下面的循环变量从1开始,而不是从0开始,因为Excel表的第一行是标题
    For n As Integer = 1 To Sheet.Rows.Count -1
        Dim bh As String = sheet(n,3).Text
        If DataTables("table_3").Find("单号 = '"& bh &"'")Is Nothing Then
            If  Sheet(n,0).text > "" Then
                Dim r As Row = Tables("table_3").AddNew()
                For m1 As Integer = 0 To Sheet.Cols.Count - 1
                    If dict.ContainsKey(Sheet(0,m1).Value)
                        r(dict(Sheet(0,m1).Value)) = Sheet(n,m1).Value
                         Dim fl As String = ProjectPath & "Attachments\" & r("单号") & ".jpg"
        If Sheet(4,4).SaveImage(fl) Then '如果照片保存成功
            r("图片") = fileSys.GetName(fl)
End If
                    End If
                Next
                r("处理人") = user.name
                r("记录")=Datetime.Today & "批量导入"
                r("状态")="已结案"
            End If
        End If
    Next
    Tables("table_3").ResumeRedraw()
    msgbox("导入成功")
End If
 老师我觉得应该放在这里但是这个不知道应该怎么改
 回到顶部
帅哥哟，离线，有人找我吗？
繁羽
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：幼狐 帖子：84 积分：512 威望：0 精华：0 注册：2021/11/30 17:01:00 		  发帖心情 Post By：2021/12/27 16:08:00 [显示全部帖子]

Dim dlg As New OpenFileDialog '定义一个新的OpenFileDialog
dlg.Filter= "Excel文件|*.xlsx|Word文件|*.doc|Access文件|*.mdb" '设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then '如果用户单击了确定按钮
    Dim nms() As String = {"状态","记录时间","店铺名称","产品类别","单号","产品SKU","责任方","状况描述 原因","客户姓名","联系方式","寄送地址","处理方式","寄送SKU","配件SKU","数量","备注","发货仓库","系统单号","追踪号","物流公司","发货日期","收货日期","下单日期","回访","记录日期","结束日期","赠送SKU","处理时间"}
    Dim nms2() As String = {"状态","记录时间","店铺名称","产品类别","单号z","产品SKU","责任方","状况描述 原因","客户姓名","联系方式","寄送地址","处理方式","寄送SKU","配件SKU","数量","备注","发货仓库","系统单号","追踪号","物流公司","发货日期","收货日期","下单日期","回访","记录日期","结束日期","赠送SKU","处理时间"}
    Dim dict As new Dictionary(of String,String)
    For m As Integer = 0 To nms.Length - 1
        dict.add(nms2(m),nms(m))
    Next
    Dim Book As New XLS.Book(dlg.FileName)
    Dim Sheet As XLS.Sheet = Book.Sheets(0)
    Tables("table_3").StopRedraw()
    '注意下面的循环变量从1开始,而不是从0开始,因为Excel表的第一行是标题
    For n As Integer = 1 To Sheet.Rows.Count -1
        Dim bh As String = sheet(n,3).Text
        If DataTables("table_3").Find("单号 = '"& bh &"'")Is Nothing Then
            If  Sheet(n,0).text > "" Then
                Dim r As Row = Tables("table_3").AddNew()
                For m1 As Integer = 0 To Sheet.Cols.Count - 1
                    If dict.ContainsKey(Sheet(0,m1).Value)
                        r(dict(Sheet(0,m1).Value)) = Sheet(n,m1).Value
                         Dim fl As String = ProjectPath & "Attachments\" & r("单号") & ".jpg"
                        If Sheet(n,1).SaveImage(fl) Then '如果照片保存成功
                        'r("图片") = fileSys.GetName(fl)
                        Dim ftp1 As New FtpClient
Dim i As Integer = 0
Dim dr As Row = Tables("Table_3").Current
    ftp1.host="172.16.120.41"
    ftp1.Account ="admin"
    ftp1.password ="qw123" 
If ftp1.MakeDir(dr("单号") & "\") Then
    
Else

End If
If ftp1.Upload(fl) = True Then
'msgbox("成功")
Else
 'msgbox("不成功")
End If
If ftp1.FileExists("\" &dr("单号")& "\" & dr("单号") & ".jpg") Then 
For i = 1 To 999 
If ftp1.FileExists("\" &dr("单号")& "\" & dr("单号")& "("&  i &").jpg")=False Then 
Exit For
End If
Next
End If 
If i > 0 Then
ftp1.Rename(FileSys.GetName(r("单号") & ".jpg"),"\" &dr("单号") &  "\" & dr("单号") &"("&  i &").jpg")
r("图片") = "\" &dr("单号") &  "\" & dr("单号") &"("&  i &").jpg"
ftp1.Delete("/" & FileSys.GetName( r("单号") & ".jpg"))
Else
ftp1.Rename(FileSys.GetName(r("单号") & ".jpg"),"\" &dr("单号") & "\" & dr("单号") &".jpg")
r("图片") = "\" &dr("单号")& "\" & dr("单号") & ".jpg"
ftp1.Delete("/" & FileSys.GetName( r("单号") & ".jpg"))
End If


                        End If
                    End If
                Next
                r("处理人") = user.name
                r("记录")=Datetime.Today & "批量导入"
                r("状态")="已结案"
            End If
        End If
    Next
    Tables("table_3").ResumeRedraw()
    msgbox("导入成功")
End If 老师 如果是单张图片的话是可以上传成功的，但是如果是多张图片，例如图这种就上传不成功
图片点击可在新窗口打开查看此主题相关图片如下：1640592397(1).jpg
图片点击可在新窗口打开查看
 回到顶部
帅哥哟，离线，有人找我吗？
繁羽
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：幼狐 帖子：84 积分：512 威望：0 精华：0 注册：2021/11/30 17:01:00 		  发帖心情 Post By：2021/12/27 16:47:00 [显示全部帖子]

If dic.ContainsKey(n) Then
                Dim ls = dic(n)
                Dim line As new List(Of String)
                For j As Integer = 0 To ls.count-1
                    Dim name = ary(n, 7) & "_" & j & ".jpg"
                    ls(j).copy
                    ClipBoard.GetImage.save(projectPath & "attachments/" & name)
                    line.add(name)
                Next
                ro.DataRow.lines("照片") = line
            End If
        Next
是不是调用这段就可以了
 回到顶部
帅哥哟，离线，有人找我吗？
繁羽
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：幼狐 帖子：84 积分：512 威望：0 精华：0 注册：2021/11/30 17:01:00 		  发帖心情 Post By：2021/12/28 11:11:00 [显示全部帖子]

Dim dlg As New OpenFileDialog
dlg.Filter = "Excel文件|*.xls;*.xlsx"
If dlg.ShowDialog =DialogResult.OK Then
   
    Dim App As New MSExcel.Application
    try
        Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(dlg.FileName)
        Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
        Dim Rg As MSExcel.Range = Ws.UsedRange
        Dim ary = rg.value
        Dim dic As new Dictionary(of Integer, List(of object))
        For Each s As object In ws.Shapes
            Dim rng = s.TopLeftCell
            If dic.ContainsKey(rng.Row) = False Then
                Dim ls As new List(Of object)
                ls.add(s)
                dic.Add(rng.Row, ls)
            Else
                dic(rng.Row).add(s)
            End If
        Next
        For n As Integer = 2 To rg.Rows.Count
            Dim ro As Row = Tables("table_3").AddNew
            For i As Integer = 0 To Tables("table_3").Cols.Count - 1
                ro(i) = ary(n,i+1)
            Next
            If dic.ContainsKey(n) Then
                Dim ls = dic(n)
                Dim line As new List(Of String)
                For j As Integer = 0 To ls.count-1
                    Dim name = ary(n, 1) & "_" & j & ".jpg"
                    ls(j).copy
                    ClipBoard.GetImage.save(projectPath & "attachments/" & name)
                    line.add(name)
                Next
                ro.DataRow.lines("图片") = line
            End If
        Next
        MessageBox.Show("导入成功!","恭喜!")
    catch ex As exception
        msgbox(ex.message)
        MessageBox.Show("导入失败!","恭喜!")
    finally
        app.quit
    End try
End If 老师还需要怎么改，才能导入呀，导入不了呀
 回到顶部
帅哥哟，离线，有人找我吗？
繁羽
 小大  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：幼狐 帖子：84 积分：512 威望：0 精华：0 注册：2021/11/30 17:01:00 		  发帖心情 Post By：2021/12/28 11:16:00 [显示全部帖子]

只有两列
图片点击可在新窗口打开查看此主题相关图片如下：1640661321(1).jpg
图片点击可在新窗口打开查看
 回到顶部
帅哥哟，离线，有人找我吗？
繁羽
 小大  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：幼狐 帖子：84 积分：512 威望：0 精华：0 注册：2021/11/30 17:01:00 		  发帖心情 Post By：2021/12/28 11:17:00 [显示全部帖子]

作为测试

 回到顶部
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.08594 秒, 5 次数据查询