以下内容为程序代码:

1 Dim dlg As New OpenFileDialog
2 dlg.Filter = "Excel文件|*.xls;*.xlsx"
3 If dlg.ShowDialog = DialogResult.OK Then
4 Dim App As New MSExcel.Application
5 Try
6 Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(dlg.FileName)
7 Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
8 Dim Rg As MSExcel.Range = Ws.UsedRange
9 Dim ary = rg.value
10 Dim dic As New Dictionary(Of Integer, List(Of Object))
11 Dim ftp1 As New FtpClient
12 ftp1.Host = "***.**.**.*"
13 ftp1.Account = "elf***"
14 ftp1.Password = "********"
15 For Each s As Object In ws.Shapes
16 Dim rng = s.TopLeftCell
17 If dic.ContainsKey(rng.Row) = False Then
18 Dim ls As New List(Of Object)
19 ls.add(s)
20 dic.Add(rng.Row, ls)
21 Else
22 dic(rng.Row).add(s)
23 End If
24 Next
25 For n As Integer = 2 To rg.Rows.Count
26 Dim ro As Row = Tables("BOM").AddNew
27 For i As Integer = 0 To Tables("BOM").Cols.Count - 1
28 ro(i) = ary(n, i + 1)
29 Next
30 If dic.ContainsKey(n) Then
31 Dim ls = dic(n)
32 Dim line As New List(Of String)
33 For j As Integer = 0 To ls.count - 1
34 Dim name = ary(n, 5) & "_" & j & ".jpg"
35 Dim khxm = "/产品图片/" & ary(n, 3)
36 ls(j).copy
37 ClipBoard.GetImage.save(projectPath & "Images/产品图片/" & name)
38 If ftp1.DirExists(khxm) Then
39 Else
40 ftp1.MakeDir(khxm)
41 End If
42 ftp1.Upload(projectPath & "Images/产品图片/" & name, khxm & "/" & name)
43 line.add(khxm & "/" & name)
44 Next
45 ro.DataRow.lines("零件图片") = line
46 End If
47 Next
48 MessageBox.Show("导入成功!", "恭喜!")
49 Catch ex As exception
50 msgbox(ex.message)
51 MessageBox.Show("导入失败!", "恭喜!")
52 Finally
53 app.quit
54 End Try
55 End If