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
加好友 
发短信
Post By：2021/9/30 9:33:00 [只看该作者]
Post By：2021/9/30 10:32:00 [只看该作者]
此主题相关图片如下：1.png