背景,前段时间领导要我每天将差不多7000行数据放在Access数据库,很笨的办法就是将数据库中的数据导出EXCEL版，在将数据添加到EXCEL里面，然后在重新导入数据库,如果是这样费时间，费力气，还容易出错，于是就有了下面的代码,下面的这段代码就是将表中的数据全部写人数据库里，但不能有编号重复的，有编号重复的将不会被导入进去。所以在往数据库里面导之前先获取数据库中的最后一个编码，
'引用Microsoft ActiveX Data Objects 2.x Library
Sub updateaddRecords2020()
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim myPath As String
Dim myTable As String
Dim strTemp As String
Dim arrFields As Variant
myPath = sjk.dz.Value
myTable = "Mywork"
On Error GoTo errmsg
If Sheets("数据").Range("L1") = "" Then
MsgBox "对不起请先获取单号", vbExclamation, "操作顺序错误"
Exit Sub
End If
cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & myPath '连接数据库
arrFields = Range("A1:I1") '工作表中的字段名写入数组
'生成更新字符串，如：a.编号=b.编号,a.料号=b.料号,……
For i = 2 To UBound(arrFields, 2)
strTemp = strTemp & ",a." & arrFields(1, i) & "=b." & arrFields(1, i)
Next
'生成更新SQL语句(请注意Office2007后需要加imex=0参数)//表中的数据不能修改
Sql = "update " & myTable & " a,[Excel 12.0;imex=0;Database=" & ActiveWorkbook.FullName & "].[数据$" _
& Range("a1").CurrentRegion.Address(0, 0) & "] b set " & Mid(strTemp, 2) & " where a.编号=b.编号"
cnn.Execute Sql '不判断，更新可能存在的“编号”
'生成数据库不存在记录的SQL语句
Sql = "select a.* from [Excel 12.0;Database=" & ActiveWorkbook.FullName & "].[数据$" & Range("a1").CurrentRegion.Address(0, 0) _
& "] a left join " & myTable & " b on a.编号=b.编号 where b.编号 is null"
Set rs = New ADODB.Recordset
rs.Open Sql, cnn, adOpenKeyset, adLockOptimistic
'插入数据库不存在记录
'如果工作表中含有数据库不存在记录
If rs.RecordCount > 0 Then
'插入新记录SQL语句
Sql = "insert into " & myTable & " " & Sql
cnn.Execute Sql
MsgBox "操作成功!已经为你更新了" & rs.RecordCount & "行数据添加到了数据库！", vbInformation, "添加数据成功"
Else
MsgBox "很抱歉的通知您,工作表的数据在数据库中编号已经存在.无法添加新的记录,请检查你的编号是否重复,如果是新的记录请把编号按照L1单元格的数据填充到编号列即可!记住不要重复哦！", vbInformation, "添加数据失败"
End If
Sheets("数据").Range("L1") = ""
'关闭连接释放内存
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
Exit Sub
errmsg:
MsgBox Err.Description, , "错误报告"
End Sub
