Dim dt As DataTable = Args(0) '需要合并的Foxtable表
Dim dCols() As String = Args(1) 'Foxtable表字段
Dim sCols() As String = Args(2) 'Excel表字段
Dim k As Integer = Args(3) 'Excel表头标题是第几行,默认第一行,即代码里的第0行
Dim dlg As New OpenFileDialog '定义一个新的OpenFileDialog
dlg.Filter= "Excel文件|*.xls;*.xlsx" '设置筛选器
dlg.MultiSelect=True '可以同时导入多个Excel表
If dlg.ShowDialog = DialogResult.Ok Then '如果用户单击了确定按钮
Dim files() As String = dlg.FileNames
Dim zd As New Dictionary(Of String, Integer) '字典记录导入字段对应Excel第几列
For i As Integer =0 To sCols.Length -1
zd.Add(sCols(i),-1)
Next
Dim err As String = ""
For Each file As String In files
Dim Book As New XLS.Book(file)
Dim Sheet As XLS.Sheet = Book.Sheets(0)
Dim j As Integer = 0 '检查Excel表头结构个数,如果都符合则 j = sCols.Length
Dim Iferr As Boolean = False '检查表头时,是否出错.
For i As Integer = 0 To Sheet.Cols.Count - 1
Dim scol As String = sheet(k-1,i).value
If zd.ContainsKey(scol) Then
j = j + 1
If zd(scol) = -1 Then
zd(scol) = i
ElseIf zd(scol) <> i Then
err = err & "Excel文件:【" & file & "】与其他文件Excel表结构不同;"
Iferr = True
Exit For
End If
End If
Next
If j <> sCols.Length AndAlso Iferr = False Then
err = err & "Excel文件:【" & file & "】的表结构个数与预设不符;"
End If
Next
If err <> "" Then '出错了
MessageBox.Show(err)
Else '进入合并
For Each file As String In files
Dim Book As New XLS.Book(file)
Dim Sheet As XLS.Sheet = Book.Sheets(0)
For n As Integer = 0 To Sheet.Rows.Count - k - 1
Dim nr As DataRow = dt.AddNew()
For i As Integer = 0 To sCols.Length -1
If dt.DataCols(dCols(i)).IsNumeric Then
Dim temp As Decimal = sheet(k+n,zd(sCols(i))).value
nr(dCols(i)) = temp
Else
nr(dCols(i)) = sheet(k+n,zd(sCols(i))).value
End If
Next
Next
Next
MessageBox.Show("导入完成")
End If
End If
加好友 
发短信
Post By：2021/7/21 17:33:00 [只看该作者]
此主题相关图片如下：11.png
