用ADO逐条写入ACCESS数据库，关键字重复时，获取错误码，并提示错误所在的行号。

cxd1001

问题：逐条写入数据库，判断发票号码是否与数据库中的发票发码（主键）重复，以下代码能捕获Err.Number信息，但是循环写下一行，没有重复的发票号码，VBA也报相同的错误代码(见截图)，找不到原因，请高手帮忙解决！

代码：

1. Sub 写入_发票信息()
   
2. Dim i1%, i2%, i3%, i4%, i5%, i6%, i7%, k%, j As Long, n As Long
   
3. Dim cnn As Object, rs As Object, SQL$
   
4. Dim wb As Workbook
   
5. Dim ws As Worksheet
   
6. Set wb = ThisWorkbook
   
7. Set ws = wb.ActiveSheet
   
8. i1 = Excel.Application.WorksheetFunction.Match("序号", ws.Rows(4), 0) '序号所在的列数
   
9. i2 = Excel.Application.WorksheetFunction.Match("发票号码", ws.Rows(4), 0) '发票号码所在的列数
   
10. i3 = Excel.Application.WorksheetFunction.Match("凭证号码", ws.Rows(4), 0) '凭证号码所在的列数
    
11. i4 = Excel.Application.WorksheetFunction.Match("名称及规格", ws.Rows(4), 0) '凭证号码所在的列数
    
12. i5 = Excel.Application.WorksheetFunction.Match("购置时间", ws.Rows(4), 0) '购置时间所在的列数
    
13. i6 = Excel.Application.WorksheetFunction.Match("数量", ws.Rows(4), 0) '数量所在的列数
    
14. i7 = Excel.Application.WorksheetFunction.Match("金额", ws.Rows(4), 0) '金额所在的列数
    
15. j = ws.Cells(Rows.Count, i2).End(xlUp).Row
    
16. '没有数据则退出
    
17. If j < 6 Then
    
18.     MsgBox "没有数据！"
    
19.     Exit Sub
    
20. End If
    
21. Set cnn = CreateObject("adodb.connection")
    
22. Set rs = CreateObject("adodb.recordset")
    
23. '建立与数据库链接
    
24. With cnn
    
25.     .provider = "microsoft.ace.oledb.12.0"
    
26.     .connectionstring = "data source=" & "E:\CTA信息管理" & "" & "技改数据.accdb"
    
27.     .Open
    
28. End With
    
29. '删除数据
    
30. SQL = "delete from 发票信息 where ID = '" & Sheets("基本信息").Range("c4") & "'"
    
31. cnn.Execute SQL
    
32. 
    
33. SQL = "select * from 发票信息 where ID = '" & Sheets("基本信息").Range("c4") & "'"
    
34. rs.Open SQL, cnn, 1, 3
    
35. On Error Resume Next
    
36. Sheets("重号发票清单").UsedRange.ClearContents
    
37. Sheets("重号发票清单").Range("a1:d1") = Array("序号", "发票号", "凭证号码", "金额")
    
38. n = 6
    
39. Do While n <= j
    
40. 
    
41.     rs.AddNew
    
42.     rs.Fields("发票号码").Value = ws.Cells(n, i2).Value
    
43.     rs.Fields("ID").Value = Sheets("基本信息").Cells(4, 3).Value
    
44.     rs.Fields("序号").Value = Int(ws.Cells(n, i1).Value)
    
45.     rs.Fields("凭证号码").Value = ws.Cells(n, i3).Value
    
46.     rs.Fields("名称及规格").Value = ws.Cells(n, i4).Value
    
47.     rs.Fields("购置时间").Value = ws.Cells(n, i5).Value
    
48.     rs.Fields("数量").Value = ws.Cells(n, i6).Value
    
49.     rs.Fields("金额").Value = ws.Cells(n, i7).Value
    
50.     rs.Update
    
51. 
    
52.         If Err.Number = -2147217887 Then
    
53.         k = k + 1
    
54. 
    
55.         MsgBox "发票重号，所在行号为：" & n & Chr(10) & Chr(10) _
    
56.         & "错误代码：" & Err.Number & Chr(10) _
    
57.         & "错误提示：" & Err.Description
    
58.         Err.Clear
    
59.         
    
60.             With Sheets("重号发票清单")
    
61.                 .Range("a" & k + 1) = ws.Cells(n, i1).Value
    
62.                 .Range("b" & k + 1) = ws.Cells(n, i2).Value
    
63.                 .Range("c" & k + 1) = ws.Cells(n, i3).Value
    
64.                 .Range("d" & k + 1) = ws.Cells(n, i7).Value
    
65.             End With
    
66.         End If
    
67.     n = n + 1
    
68. Loop
    
69. 'myout:
    
70. '
    
71. '    If Err.Number = -2147217887 Then
    
72. '        MsgBox "发票重号，所在行号为" & n
    
73. '
    
74. '    Else
    
75. '        MsgBox "其他错误，错误代码：" & Err.Number & "，错误内容：" & Err.Description
    
76. '
    
77. '    End If
    
78. 
    
79. '    Resume Next
    
80. 
    
81. 'MsgBox Err.Description '错误的描述
    
82. 
    
83. MsgBox "数据保存完毕！", vbInformation + vbOKOnly
    
84. rs.Close
    
85. cnn.Close
    
86. Set rs = Nothing
    
87. Set cnn = Nothing
    
88. Set wb = Nothing
    
89. Set ws = Nothing
    
90. End Sub
    

复制代码

数据表

EXCEL文件

错误提示

错误提示

cxd1001

，或者有没有其他的方法可以实现重复提示。

tanglf188

ID主键一般都是自动编号，具有唯一性，发票号就不要设置主键了

cxd1001

tanglf188 发表于 2024-5-10 09:41
ID主键一般都是自动编号，具有唯一性，发票号就不要设置主键了

主要目的是发票号码不能重号，说明重复报销了

cxd1001

tanglf188 发表于 2024-5-10 09:41
ID主键一般都是自动编号，具有唯一性，发票号就不要设置主键了

此表的ID，与基本信息表的ID是一致的，而基本信息表的ID就是自动编号 的

cxd1001

tanglf188 发表于 2024-5-10 09:41
ID主键一般都是自动编号，具有唯一性，发票号就不要设置主键了

发票重号检测，主是是防止重复记账

tanglf188

cxd1001 发表于 2024-5-10 09:48
主要目的是发票号码不能重号，说明重复报销了

你代码不是判断了吗，如果代码不判断，数据库用主键设置唯一性还是会报错的，所以还是用代码判断唯一性就可以了，没必要设置主键

cxd1001

tanglf188 发表于 2024-5-10 10:11
你代码不是判断了吗，如果代码不判断，数据库用主键设置唯一性还是会报错的，所以还是用代码判断唯一性就 ...

问题在于怎么判断EXCEL文件中的发票号与ACCESS数据表中已有发票号是否重号，原先我是通过设置唯一性，存入时报销，获取ERR的值，实现重号提示的

cxd1001

或者用其他方法实现，EXCEL表中的发票号码字段值在Access发票信息表中发票号码是否已存在，并给出提示

cxd1001

有什么好的建议？在线等