無法插入數據庫內未存在數據

冰殤

數據庫內未存在此單號,則新建數據
但無法新建數據

1.    '引用Microsoft ActiveX Data Objects 2.x Library
   
2. Sub updateaddRecords2007()
   
3.     Dim cnn As New ADODB.Connection
   
4.     Dim rs As New ADODB.Recordset
   
5.     Dim myPath As String
   
6.     Dim myTable As String
   
7.     Dim strTemp As String
   
8.     Dim arrFields As Variant
   
9. On Error Resume Next
   
10.    
    
11. 
    
12. Application.ScreenUpdating = False
    
13. 
    
14.     myPath = "\\資料庫\資料庫.accdb"
    
15.     myTable = "客戶清單"
    
16.    ' On Error GoTo errmsg
    
17.     cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & myPath '連接數據庫
    
18.    
    
19.     arrFields = Range("A1:as1") '工作表中的字段名寫入數組
    
20.    
    
21.     '生成更新字符串，如：a.姓名=b.姓名,a.性別=b.性別,……
    
22.     For i = 2 To UBound(arrFields, 2)
    
23.         strTemp = strTemp & ",a." & arrFields(1, i) & "=b." & arrFields(1, i)
    
24.     Next
    
25.     '生成更新SQL語句(請注意Office2007後需要加imex=0參數)
    
26.     SQL = "update " & myTable & " a,[Excel 12.0;imex=0;Database=" & ActiveWorkbook.FullName & "].[收款跟催$" _
    
27.         & Range("a1").CurrentRegion.Address(0, 0) & "] b set " & Mid(strTemp, 2) & " where a.單號=b.單號"
    
28.     cnn.Execute SQL '不判斷，更新可能存在的「單號」
    
29. 
    
30.     '生成數據庫不存在記錄的SQL語句
    
31.     SQL = "select a.* from [Excel 12.0;Database=" & ActiveWorkbook.FullName & "].[收款跟催$" & Range("a1").CurrentRegion.Address(0, 0) _
    
32.         & "] a left join " & myTable & " b on a.單號=b.單號 where b.單號 is null"
    
33.     Set rs = New ADODB.Recordset
    
34.     rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    
35.    
    
36.     '插入數據庫不存在記錄
    
37.     If rs.RecordCount > 0 Then '如果工作表中含有數據庫不存在記錄
    
38.         SQL = "insert into " & myTable & " " & SQL '插入新記錄SQL語句
    
39.         cnn.Execute SQL
    
40.         'MsgBox rs.RecordCount & "行數據已經添加到數據庫！", vbInformation, "添加數據"
    
41.     Else
    
42.          'MsgBox "工作表的數據數據庫中已經存在。", vbInformation, "添加數據失敗"
    
43.     End If
    
44.    
    
45.     '關閉連接釋放內存
    
46.     rs.Close
    
47.     cnn.Close
    
48.     Set rs = Nothing
    
49.     Set cnn = Nothing
    
50. Application.ScreenUpdating = True
    
51.    
    
52.     Exit Sub
    
53. errmsg:
    
54.     MsgBox Err.Description, , "錯誤報告"
    
55. 
    
56. End Sub
    
57. 
    

复制代码

roych

试试Upset语句：

1. UPDATE 设备总表2 LEFT JOIN 设备总表1 ON 设备总表2.节点地址 = 设备总表1.节点地址 SET 设备总表1.销售日 = Date()-1, 设备总表1.节点地址 = [设备总表2].[节点地址] WHERE 设备总表1.节点地址 Is Null ;

复制代码

详细请留意：
http://www.office-cn.net/thread-120230-1-1.html