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


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

主题：导出
帅哥哟，离线，有人找我吗？
aaa1234
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：四尾狐 帖子：825 积分：1650 威望：0 精华：0 注册：2021/7/30 8:48:00 		导出  发帖心情 Post By：2021/12/29 9:44: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 = {"单号"}

    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

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


                    line.add(name1)

                Next

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

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

            End If

        Next

 app.quit

    

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


加好友 发短信
等级：四尾狐 帖子：825 积分：1650 威望：0 精华：0 注册：2021/7/30 8:48:00 		  发帖心情 Post By：2021/12/29 9:45:00 [显示全部帖子]

老师我想问一下，怎么稍微改一下 line.add可以添加到name1呢

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


加好友 发短信
等级：四尾狐 帖子：825 积分：1650 威望：0 精华：0 注册：2021/7/30 8:48:00 		  发帖心情 Post By：2021/12/29 10: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 = {"单号"}

    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

            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


                    line.add(name1)

                Next

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

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

            End If

        Next

 app.quit

    

End If 他说我放在里面 ，未声明name1
图片点击可在新窗口打开查看此主题相关图片如下：1640745591(1).jpg
图片点击可在新窗口打开查看
 回到顶部
帅哥哟，离线，有人找我吗？
aaa1234
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：四尾狐 帖子：825 积分：1650 威望：0 精华：0 注册：2021/7/30 8:48:00 		  发帖心情 Post By：2021/12/29 11:14:00 [显示全部帖子]

老师可以加上这个判断进去的吗
Dim Book As New XLS.Book("c:\test\订单.xls")
Dim Sheet As XLS.Sheet = Book.Sheets(0)
Tables("订单").StopRedraw()
'注意以下数组中列名称的顺序,必须和Excel表中的列顺序一致
Dim nms() As String = {"编号","产品","客户","雇员","单价","折扣","数量","日期"}
'注意下面的循环变量从1开始,而不是从0开始,因为Excel表的第一行是标题
For n As Integer = 1 To Sheet.Rows.Count -1
    Dim bh As String = sheet(n,0).Text
    If DataTables("订单").Find("编号 = '" & bh & "'") Is Nothing Then '如果不存在同编号的订单
        Dim r As Row = Tables("订单").AddNew()
        For m As Integer = 0 To nms.Length - 1
            r(nms(m)) = Sheet(n,m).Value
 回到顶部
帅哥哟，离线，有人找我吗？
aaa1234
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：四尾狐 帖子：825 积分：1650 威望：0 精华：0 注册：2021/7/30 8:48:00 		  发帖心情 Post By：2021/12/29 11:24:00 [显示全部帖子]

以为他就是有的单号一样还继续添加所以想加这个判断，就不知道Dim bh As String = sheet(n,0).Text
    If DataTables("订单").Find("编号 = '" & bh & "'") Is Nothing Then '如果不存在同编号的订单
bh是改成什么
[此贴子已经被作者于2021/12/29 11:24:56编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
aaa1234
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：四尾狐 帖子：825 积分：1650 威望：0 精华：0 注册：2021/7/30 8:48:00 		  发帖心情 Post By：2021/12/29 14:58:00 [显示全部帖子]

不是，老师您理解错了，就是table_3里面有一个单号为aaa，然后我excel里面也有aaa，我现在的代码导入进去的话因为我做了判断If e.DataCol.Name = "单号" Then
    Dim dr As DataRow
    dr = e.DataTable.SQLFind("单号 = '" & e.NewValue & "'")
    If dr IsNot Nothing Then
        MessageBox.Show("此单号已经存在!")
        e.Cancel = True
    End If
End If
所以他导入进去是单号是空白，其他的都能导入进去嘛，我是想我table_3里面有aaa，我excel里面有aaa，我导入进去，判断aaa是否存在，不存在导出aaa，存在跳过aaa
 回到顶部
帅哥哟，离线，有人找我吗？
aaa1234
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：四尾狐 帖子：825 积分：1650 威望：0 精华：0 注册：2021/7/30 8:48:00 		  发帖心情 Post By：2021/12/29 15:50:00 [显示全部帖子]

老师你尝试一下导入
 下载信息  [文件大小：   下载次数： ]
图片点击可在新窗口打开查看点击浏览该文件:导入test1.zip

一次保存再导入一次，看一下会不会跳过吧图片点击可在新窗口打开查看

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


加好友 发短信
等级：四尾狐 帖子：825 积分：1650 威望：0 精华：0 注册：2021/7/30 8:48:00 		  发帖心情 Post By：2021/12/29 16:21:00 [显示全部帖子]

我就是不知道八楼的代码怎么插进去才问您的嘛图片点击可在新窗口打开查看

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


加好友 发短信
等级：四尾狐 帖子：825 积分：1650 威望：0 精华：0 注册：2021/7/30 8:48:00 		  发帖心情 Post By：2022/1/13 16:57: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 = {"单号","处理人"}

    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)
Dim Book As New XLS.Book(dlg.FileName)
Dim Sheet As XLS.Sheet=Book.Sheets(0)
            Dim bh As String = sheet(n,0).Text
    If DataTables("table_3").Find("单号 = '" & bh & "'") Is Nothing Then
            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

            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

        Next

 app.quit
End If
End If
[此贴子已经被作者于2022/1/15 8:39:38编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
aaa1234
 小大  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：四尾狐 帖子：825 积分：1650 威望：0 精华：0 注册：2021/7/30 8:48:00 		  发帖心情 Post By：2022/1/13 17:05:00 [显示全部帖子]

老师是不是应该加在这里

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