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
加好友 
发短信
Post By：2022/1/15 16:23:00 [只看该作者]
