'将数组arr上传到cnt的tablename表中,dic_field_mapping中key是arr的标题,value是database中的对应标题
'其中arr必须带字段,否则无法匹配上传
'如果dic_field_mapping为nothing,默认数组的字段和数据库中的相同
'如果tracking_id为0,则不管tracking_id的上传,如果不为0,则上传到名为tracking_id的字段
'By Dawei GAO,2020-11-13
Sub ArrayToDatatable(ByVal arr As Variant, ByVal tablename As String, cnt As Object, Optional ByVal dic_field_mapping As Object = Nothing, _
Optional ByVal chunck_size As Long = 1000, Optional tracking_id As Long = 0)
Dim sql As String, rst As Object
Dim ro As Long, lstro As Long
Dim col As Long, lstcol As Long
Dim field As Variant
Dim dic_fields As Object
Set rst = CreateObject("adodb.recordset")
lstro = UBound(arr, 1)
lstcol = UBound(arr, 2)
If dic_field_mapping Is Nothing Then
Set dic_field_mapping = CreateObject("scripting.dictionary")
For col = 1 To lstcol
dic_field_mapping(arr(1, col)) = arr(1, col)
Next col
Else
For col = 1 To lstcol
If Not dic_field_mapping.exists(arr(1, col)) Then
dic_field_mapping(arr(1, col)) = arr(1, col)
End If
Next col
End If
'
sql = StringFormat("select * from {0} where 1=2", tablename)
rst.Open sql, cnt, 1, 3
Set dic_fields = GetFieldsCollectionFromRecordset(rst)
'上传数据
With rst
If tracking_id = 0 Then
For ro = 2 To lstro
.AddNew
For col = 1 To lstcol
If dic_field_mapping.exists(arr(1, col)) Then
field = dic_field_mapping(arr(1, col))
If dic_fields.exists(field) Then '数据库中有这个字段才上传
.Fields(field) = arr(ro, col)
End If
End If
Next
If (ro Mod chunck_size = 1) Or (ro = lstro) Then
.Update
End If
Next ro
Else
For ro = 2 To lstro
.AddNew
For col = 1 To lstcol
If dic_field_mapping.exists(arr(1, col)) Then
field = dic_field_mapping(arr(1, col))
If dic_fields.exists(field) Then '数据库中有这个字段才上传
.Fields(field) = arr(ro, col)
End If
End If
Next
.Fields("tracking_id") = tracking_id
If (ro Mod chunck_size = 1) Or (ro = lstro) Then
.Update
End If
Next ro
End If
.Close
End With
End Sub
【VBA】将数组上传到数据表自定义函数
最新推荐文章于 2023-07-03 16:43:15 发布