Foxtable(狐表)用户栏目专家坐堂 → 导出


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

主题:导出

帅哥哟,离线,有人找我吗?
aaa1234
  21楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:四尾狐 帖子:825 积分:1650 威望:0 精华:0 注册:2021/7/30 8:48:00
  发帖心情 Post By:2022/1/15 16:23:00 [只看该作者]

.NET Framework 版本:4.0.30319.42000
Foxtable 版本:2022.1.10.2
错误所在事件:窗口,窗口1,Button1,Click
详细错误信息:
GDI+ 中发生一般性错误。报错代码
Dim dlg As New OpenFileDialog

dlg.Filter = "Excel文件|*.xls;*.xlsx"

If dlg.ShowDialog =DialogResult.OK Then

   

    Dim App As New MSExcel.Application

  Dim nms() As String = {"单号","处理人"}

    Dim nms2() As String = {"单号","处理人"}
        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 dic2 As new Dictionary(of String, Integer)
For i As Integer = 1 To rg.Columns.Count
dic2.Add(ary(1,i),i)
Next

        Dim dic As new Dictionary(of Integer, List(of object))

        For Each s As object In ws.Shapes

            Dim rng = s.TopLeftCell

Output.Show("rng.Row=" & rng.Row)

            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

Output.Show("dic.keys=" & dic.keys.count)

        For n As Integer = 2 To rg.Rows.Count
            If DataTables("table_3").Find("单号 = '" & ary(n, 1) & "'") Is Nothing Then
            Dim ro As Row = Tables("table_3").AddNew
            
            For Each k As String In dic2.Keys
If Tables("table_3").Cols.Contains(k) AndAlso k <> "图片"
                ro(k) = ary(n,dic2(k))
                
End If  

            Next
            If dic.ContainsKey(n) Then

                Dim ls = dic(n)

Output.Show("ls.count=" & ls.count)

                Dim line As new List(Of String)

                For j As Integer = 0 To ls.count-1

                    Dim name = ary(n, 1) & "_" & j & ".jpg"

Output.Show("name=" & name)
                    msgbox(name)

                    ls(j).copy

                    ClipBoard.GetImage.save(projectPath & "attachments\" & name)

Output.Show("attachments=" & projectPath & "attachments\" & name)
Dim proc As new Process
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(projectPath & "attachments\" & name) = 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(projectPath & "attachments\" & name),"\" &dr("记录时间") &  "\" & dr("记录时间") &"("&  i &").jpg")
Dim name1 ="\" &dr("记录时间") & "\" & dr("记录时间") &"("&  i &").jpg"
     line.add(name1)
ftp1.Delete("/" & FileSys.GetName(projectPath & "attachments\" & name))
Else
ftp1.Rename(FileSys.GetName(projectPath & "attachments\" & name),"\" &dr("记录时间") & "\" & dr("记录时间") &".jpg")
Dim name1="\" &dr("记录时间") & "\" & dr("记录时间") &".jpg"
     line.add(name1)
ftp1.Delete("/" & FileSys.GetName(projectPath & "attachments\" & name))
End If



                Next

                ro.DataRow.lines("图片") = line

Output.Show("line=" & line.count)

            End If
            End If 
        Next

 app.quit
End If

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


加好友 发短信
等级:超级版主 帖子:85589 积分:434320 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2022/1/15 16:47:00 [只看该作者]

1、图片本身有问题
2、图片名称有没有特殊符号?

Output.Show("name=" & name) ‘’图片名称有没有特殊符号?
                    msgbox(name)

                    ls(j).copy
try
                    ClipBoard.GetImage.save(projectPath & "attachments\" & name)
catch ex as exception
Output.Show("图片异常无法保存=" & ex.message)
end try

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


加好友 发短信
等级:四尾狐 帖子:825 积分:1650 威望:0 精华:0 注册:2021/7/30 8:48:00
  发帖心情 Post By:2022/1/15 17:59:00 [只看该作者]

老师我想问一下如果没条信息都自动填入处理人=user.name应该怎么写,以刚刚发的代码为基础

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


加好友 发短信
等级:超级版主 帖子:85589 积分:434320 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2022/1/16 20:31:00 [只看该作者]

很基础的功能呀
Dim ro As Row = Tables("table_3").AddNew
ro("处理") = ""user.name

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


加好友 发短信
等级:四尾狐 帖子:825 积分:1650 威望:0 精华:0 注册:2021/7/30 8:48:00
  发帖心情 Post By:2022/1/18 11:40:00 [只看该作者]

Dim dlg As New OpenFileDialog

dlg.Filter = "Excel文件|*.xls;*.xlsx"

If dlg.ShowDialog =DialogResult.OK Then

   

    Dim App As New MSExcel.Application

  Dim nms() As String = {"记录日期","单号","产品SKU","状况描述 原因","处理方式","赠送SKU","备注","数量","寄送地址","下单日期","追踪号","系统单号","店铺名称","运费金额"}

    Dim nms2() As String = {"记录日期","单号","产品SKU","状况描述 原因","处理方式","赠送SKU","备注","数量","寄送地址","下单日期","追踪号","系统单号","店铺名称","运费金额"}

        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 dic2 As new Dictionary(of String, Integer)
For i As Integer = 1 To rg.Columns.Count
dic2.Add(ary(1,i),i)
Next

        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
            If DataTables("table_3").Find("单号 = '" & ary(n, 1) & "'") Is Nothing Then
            Dim ro As Row = Tables("table_3").AddNew
            
            For Each k As String In dic2.Keys
If Tables("table_3").Cols.Contains(k) AndAlso k <> "图片"
                ro(k) = ary(n,dic2(k))
                
End If  

            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
try
                    ClipBoard.GetImage.save(projectPath & "attachments\" & name)
catch ex As exception
Output.Show("图片异常无法保存=" & ex.message)
End try

Output.Show("attachments=" & projectPath & "attachments\" & name)
Dim proc As new Process
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(projectPath & "attachments\" & name) = True Then
Else
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(projectPath & "attachments\" & name),"\" &dr("记录时间") &  "\" & dr("记录时间") &"("&  i &").jpg")
Dim name1 ="\" &dr("记录时间") & "\" & dr("记录时间") &"("&  i &").jpg"
     line.add(name1)
ftp1.Delete("/" & FileSys.GetName(projectPath & "attachments\" & name))
Else
ftp1.Rename(FileSys.GetName(projectPath & "attachments\" & name),"\" &dr("记录时间") & "\" & dr("记录时间") &".jpg")
Dim name1="\" &dr("记录时间") & "\" & dr("记录时间") &".jpg"
     line.add(name1)
ftp1.Delete("/" & FileSys.GetName(projectPath & "attachments\" & name))
End If



                Next
                ro("处理人") = user.name
                ro.DataRow.lines("图片") = line


            End If
            End If 
        Next

 app.quit
End If

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


加好友 发短信
等级:四尾狐 帖子:825 积分:1650 威望:0 精华:0 注册:2021/7/30 8:48:00
  发帖心情 Post By:2022/1/18 11:40:00 [只看该作者]

老师为什么还是table里面跟表里面相同的不会跳过

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


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

确定有这个单号?数据有全部加载吗

        For n As Integer = 2 To rg.Rows.Count
msgbox("单号 = '" & ary(n, 1) & "'")
            If DataTables("table_3").Find("单号 = '" & ary(n, 1) & "'") Is Nothing Then
            Dim ro As Row = Tables("table_3").AddNew
            
[此贴子已经被作者于2022/1/18 11:47:18编辑过]

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


加好友 发短信
等级:四尾狐 帖子:825 积分:1650 威望:0 精华:0 注册:2021/7/30 8:48:00
  发帖心情 Post By:2022/1/19 16:00:00 [只看该作者]

老师有没有清空回收站站的指令

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


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

我也不懂

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


加好友 发短信
等级:四尾狐 帖子:825 积分:1650 威望:0 精华:0 注册:2021/7/30 8:48:00
  发帖心情 Post By:2022/1/19 16:32:00 [只看该作者]

就是删除的垃圾不是在回收站的吗,我想把回收站清空,可以用代码解决吗

 回到顶部
总数 30 上一页 1 2 3