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))
Dim ftp1 As New FtpClient
ftp1.Host = "120.27.45.3"
ftp1.Account = "elfing"
ftp1.Password = "12345678"
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("BOM").AddNew
For i As Integer = 0 To Tables("BOM").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, 5) & "_" & j & ".jpg"
Dim khxm = "/产品图片/" & ary(n, 3)
ls(j).copy
ClipBoard.GetImage.save(projectPath & "Images/产品图片/" & name)
If ftp1.DirExists(khxm) Then
Else
ftp1.MakeDir(khxm)
End If
ftp1.Upload(projectPath & "Images/产品图片/" & name, khxm & "/" & name)
line.add(khxm & "/" & 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
加好友 
发短信
Post By：2022/12/14 12:21:00 [只看该作者]
