|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
请参考:- Sub updateaddRecordyyy() '更新数据库已经存在记录,插入不存在记录
- Dim cnn As New ADODB.Connection
- Dim rst As New ADODB.Recordset
- Dim myPath As String
- Dim myTable As String
- Dim strTemp As String
- Dim SQL As String
- Dim strMsg As String
- Dim s As String
- Dim aField As Variant
- myPath = ThisWorkbook.Path & "\记录.mdb"
- myTable = "收入记录"
- On Error GoTo ErrMsg
- cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myPath '连接数据库
- ' 生成更新SQL语句
- SQL = "SELECT B.ID号,B.挂号 FROM " & myTable & " A,[Excel 8.0;Database=" & ThisWorkbook.FullName & ";].[" & ActiveSheet.Name & "$" _
- & Range("A1").CurrentRegion.Address(0, 0) & "] B WHERE A.ID号=B.ID号 AND A.挂号=B.挂号"
- Set rst = New ADODB.Recordset
- rst.Open SQL, cnn, adOpenKeyset, adLockOptimistic
- If rst.RecordCount > 0 Then
- aField = Range("A1:N1") '工作表中的字段名写入数组
- ' 生成更新字符串,如:a.科室名称=b.科室名称,a.西药费=b.西药费,……
- For i = 2 To UBound(aField, 2)
- If i <> 4 Then strTemp = strTemp & ",a." & aField(1, i) & "=b." & aField(1, i)
- s = s & ",A." & aField(1, i)
- Next
- SQL = "UPDATE " & myTable & " A,[Excel 8.0;Database=" & ThisWorkbook.FullName & ";].[" & ActiveSheet.Name & "$" _
- & Range("A1").CurrentRegion.Address(0, 0) & "] B SET " & Mid(strTemp, 2) & " WHERE A.ID号=B.ID号 AND A.挂号=B.挂号"
- cnn.Execute SQL
- strMsg = rst.RecordCount & "条记录已更新!"
- End If
- If rst.RecordCount < Range("A" & Rows.Count).End(xlUp).Row - 1 Then
- ' 生成数据库不存在记录的SQL语句
- SQL = " SELECT " & Mid(s, 2) & " FROM [Excel 8.0;Database=" & ThisWorkbook.FullName & ";].[" & ActiveSheet.Name & "$" & Range("A1").CurrentRegion.Address(0, 0) _
- & "] A LEFT JOIN " & myTable & " B ON A.ID号=B.ID号 AND A.挂号=B.挂号 WHERE B.ID号 IS NULL"
- Set rst = New ADODB.Recordset
- rst.Open SQL, cnn, adOpenKeyset, adLockOptimistic
-
- '插入数据库不存在记录
- If rst.RecordCount > 0 Then '如果工作表中含有数据库不存在记录
- SQL = "INSERT INTO " & myTable & SQL
- cnn.Execute SQL
- strMsg = strMsg & vbCrLf & rst.RecordCount & "条记录已添加到数据库!"
- End If
- End If
- MsgBox strMsg, vbInformation, "提示"
- ' 关闭连接释放内存
- rst.Close
- cnn.Close
- Set rst = Nothing
- Set cnn = Nothing
- Exit Sub
- ErrMsg:
- MsgBox Err.Description, , "错误报告"
- End Sub
复制代码 |
评分
-
2
查看全部评分
-
|