|
本帖最后由 zhaogang1960 于 2013-4-23 18:01 编辑
请测试:- Sub 更新插入数据()
- Dim cnn As Object, rs As Object, SQL$
- Dim arr, i&, s$
- arr = Range("A1:G1")
- For i = 3 To UBound(arr, 2)
- If i <> 5 Then
- s = s & ",a." & arr(1, i) & "=b." & arr(1, i)
- Else
- s = s & ",a." & arr(1, i) & "=cstr(b." & arr(1, i) & ")"
- End If
- Next
- Set cnn = CreateObject("adodb.connection")
- cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\test.accdb"
- SQL = "update Sheet1 a,[Excel 12.0;imex=0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" & [a1].CurrentRegion.Address(0, 0) & "] b set " & Mid(s, 2) & " where a.LastName=b.LastName and a.FirstName=b.FirstName"
- cnn.Execute SQL '不判断,更新可能存在的LastName和FirstName
- SQL = "select a.* from [Excel 12.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" & [a1].CurrentRegion.Address(0, 0) _
- & "] a left join Sheet1 b on a.LastName=b.LastName and a.FirstName=b.FirstName where b.LastName is null"
- Set rs = CreateObject("adodb.recordset")
- rs.Open SQL, cnn, 1, 3
- If rs.RecordCount Then
- SQL = "insert into Sheet1 " & SQL
- cnn.Execute SQL
- MsgBox rs.RecordCount & "行数据已经添加到数据库!", vbInformation
- Else
- MsgBox "工作表的数据数据库中已经存在。", vbInformation
- End If
- rs.Close
- cnn.Close
- Set rs = Nothing
- Set cnn = Nothing
- End Sub
复制代码 |
|