|
YincyHe 发表于 2013-4-25 10:59
不好意思,传错了、、、你看看这个 - Sub 更新插入数据()
- Dim cnn As Object, rs As Object, SQL$
- Dim arr, i&, s$
- arr = Range("A1:G1")
- For i = 1 To UBound(arr, 2)
- If i <> 1 And i <> 4 And i <> 5 And i <> 8 Then s = s & ",a." & arr(1, i) & "=b." & arr(1, i)
- Next
- Set cnn = CreateObject("adodb.connection")
- cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\test1.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.CustID=b.CustID and a.ContID=b.ContID and a.SiteID=b.SiteID"
- 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.CustID=b.CustID and a.ContID=b.ContID and a.SiteID=b.SiteID where b.CustID 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
复制代码 |
评分
-
1
查看全部评分
-
|