一个VBA数据库连接例子
2016年2月03日 21:59
一个VBA数据库连接例子
Sub updateaddRecords2003()
'引用Microsoft ActiveX Data Objects 2.x Library'
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 = ThisWorkbook.Path & "\学校管理.mdb"
myTable = "学生档案"
On Error GoTo errmsg
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myPath
'连接数据库'
arrFields = Range("A1:J1") '工作表中的字段名写入数组'
'生成更新字符串，如：a.姓名=b.姓名,a.性别=b.性别,……'
For i = 2 To UBound(arrFields, 2)
strTemp = strTemp & ",a." & arrFields(1, i) & "=b." & arrFields(1, i)
Next
'生成更新SQL语句'
SQL = "update " & myTable & " a,[Excel 8.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 8.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 = "insert into " & myTable & " " & SQL '插入新记录SQL语句
cnn.Execute SQL
MsgBox rs.RecordCount & "行数据已经添加到数据库！", vbInformation, "添加数据"
Else
MsgBox "工作表的数据数据库中已经存在。", vbInformation, "添加数据失败"
End If
'关闭连接释放内存'
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
Exit Sub
errmsg:
MsgBox Err.Description, , "错误报告"
End Sub
