Foxtable(狐表) → 用户栏目 → 专家坐堂 → 导入数据


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

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


加好友 发短信
等级：婴狐 帖子：24 积分：211 威望：0 精华：0 注册：2021/9/28 17:17:00 		导入数据  发帖心情 Post By：2021/9/29 17:55: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("dd").AddNew
            For i As Integer = 0 To Tables("dd").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, 7) & "_" & 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 
 回到顶部
帅哥哟，离线，有人找我吗？
fox-
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：婴狐 帖子：24 积分：211 威望：0 精华：0 注册：2021/9/28 17:17:00 		  发帖心情 Post By：2021/9/29 17:57: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
 毕竟我只想要1楼的上传图片哪里，麻烦老师了，不懂

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


加好友 发短信
等级：婴狐 帖子：24 积分：211 威望：0 精华：0 注册：2021/9/28 17:17:00 		  发帖心情 Post By：2021/9/30 8:48: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 这一段吗，老师怎么把这个跟二楼结合，批量导入数据的同时，可以上传图片
 回到顶部
帅哥哟，离线，有人找我吗？
fox-
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：婴狐 帖子：24 积分：211 威望：0 精华：0 注册：2021/9/28 17:17:00 		  发帖心情 Post By：2021/9/30 9:05:00 [显示全部帖子]

老师我问的是二楼的代码他上传不到图片嘛，怎么结合4楼的代码可以上传

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


加好友 发短信
等级：婴狐 帖子：24 积分：211 威望：0 精华：0 注册：2021/9/28 17:17:00 		  发帖心情 Post By：2021/9/30 9:26:00 [显示全部帖子]

这个是range成员应该怎么改好呢
图片点击可在新窗口打开查看此主题相关图片如下：1632965064(1).jpg
图片点击可在新窗口打开查看
 回到顶部
帅哥哟，离线，有人找我吗？
fox-
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：婴狐 帖子：24 积分：211 威望：0 精华：0 注册：2021/9/28 17:17:00 		  发帖心情 Post By：2021/9/30 9:38: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
        Dim nms() As String = {"学校","报考岗位","姓名","准考证号","笔试成绩","排名","身份证号","照片"}
        Dim s1 As new List(of String)
        s1.Addrange(nms)
        Dim dict As new Dictionary(of String,Integer)
          For m As Integer = 1 To rg.Columns.Count
            If s1.Contains(ary(0,m)) Then
                dict.add(ary(0,m),m)
            End If
        Next
        For n As Integer = 2 To rg.Rows.Count
            If DataTables("dd").Find("身份证号 = '" & ary(n,dict("身份证号")) & "'") Is Nothing Then
                Dim ro As Row = Tables("dd").AddNew
                For i As Integer = 0 To nms.length - 1
                    ro(i) = ary(n,dict(nms(i)))
                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,7) & "_" & j & ".jpg"
                        ls(j).copy
                        ClipBoard.GetImage.save(projectPath & "attachments/" & name)
                        line.add(name)
                    Next
                    ro.DataRow.lines("照片") = line
                End If
            End If
        Next
        MessageBox.Show("导入成功!","恭喜!")
    catch ex As exception
        msgbox(ex.message)
        MessageBox.Show("导入失败!","恭喜!")
    finally
        app.quit
    End try
End If 索引超出数组
 回到顶部
帅哥哟，离线，有人找我吗？
fox-
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：婴狐 帖子：24 积分：211 威望：0 精华：0 注册：2021/9/28 17:17:00 		  发帖心情 Post By：2021/9/30 10:32: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
        Dim nms() As String = {"学校","报考岗位","姓名","准考证号","笔试成绩","排名","身份证号","照片"}
        Dim s1 As new List(of String)
        s1.Addrange(nms)
        Dim dict As new Dictionary(of String,Integer)
        For m As Integer = 1 To rg.Columns.Count
            If s1.Contains(ary(1,m)) Then
                dict.add(ary(1,m),m)
            End If
        Next
        For n As Integer = 2 To rg.Rows.Count
            If DataTables("dd").Find("身份证号 = '" & ary(n,dict("身份证号")) & "'") Is Nothing Then
                Dim ro As Row = Tables("dd").AddNew
                For i As Integer = 0 To nms.length - 1
                    ro(i) = ary(n,dict(nms(i)))
                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,7) & "_" & j & ".jpg"
                        ls(j).copy
                        ClipBoard.GetImage.save(projectPath & "attachments/" & name)
                        line.add(name)
                        system.Threading.Thread.Sleep(1000)
                        Dim proc As new Process
                        Dim ftp1 As New FtpClient
                        Dim i As Integer = 0
                        Dim dr As Row = Tables("dd").Current
                        ftp1.host="172.16.120.41"
                        ftp1.Account ="admin"
                        ftp1.password ="qw123"
                        If ftp1.MakeDir(dr("身份证号") & "\") Then
                            Messagebox.Show("创建目录成功!")
                        Else
                            Messagebox.Show("不成功!")
                        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")
                            ftp1.Delete("/" & FileSys.GetName(dlg.FileName))
                        Else
                            ftp1.Rename(FileSys.GetName(projectPath & "attachments/" & name),"\" &dr("身份证号") & "\" & dr("身份证号") &".jpg")
                            ftp1.Delete("/" & FileSys.GetName(projectPath & "attachments/" & name))
                        End If
                    Next
                    ro.DataRow.lines("照片") = line
                End If
            End If
        Next
        MessageBox.Show("导入成功!","恭喜!")
    catch ex As exception
        msgbox(ex.message)
        MessageBox.Show("导入失败!","恭喜!")
    finally
        app.quit
    End try
End If
 回到顶部
帅哥哟，离线，有人找我吗？
fox-
 小大  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：婴狐 帖子：24 积分：211 威望：0 精华：0 注册：2021/9/28 17:17:00 		  发帖心情 Post By：2021/9/30 10:32:00 [显示全部帖子]

老师现在的主要问题是上传不了多张图片打ftp

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


加好友 发短信
等级：婴狐 帖子：24 积分：211 威望：0 精华：0 注册：2021/9/28 17:17:00 		  发帖心情 Post By：2021/9/30 10:57:00 [显示全部帖子]

11

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


加好友 发短信
等级：婴狐 帖子：24 积分：211 威望：0 精华：0 注册：2021/9/28 17:17:00 		  发帖心情 Post By：2021/9/30 10:59:00 [显示全部帖子]

1
 下载信息  [文件大小：   下载次数： ]
图片点击可在新窗口打开查看点击浏览该文件:testdemo.zip
 回到顶部
总数 11 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.08496 秒, 6 次数据查询