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

tanglf188

在模块3里，请参考

tanglf188

直接用函数判断某个发票号码是否存在如下

cxd1001

tanglf188 发表于 2024-5-10 15:16
直接用函数判断某个发票号码是否存在如下

好的，稍后试一下，感谢

cxd1001

tanglf188 发表于 2024-5-10 15:16
直接用函数判断某个发票号码是否存在如下

能否改进一下，根据《审核清单》表j6:j16批量判断是否重号？重号的写入《重号发票清单》表

cxd1001

tanglf188 发表于 2024-5-10 15:16
直接用函数判断某个发票号码是否存在如下

可以了，谢谢！

cxd1001

借鉴上述意见，用了GetRows 方法
Sub 发票重号检测()
    Dim Cnn As Object, rs As Object
    Dim Cnn_str$, Path_str$, Pass_str$, SQL$
    Dim i As Integer, j As Integer, last As Integer
    Set Cnn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.RecordSet")
    Path_str = "E:\CTA信息管理" & "\" & "技改数据.accdb"
    Cnn_str = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                 "Data Source=" & Path_str & ";" & _
                 "Persist Security Info=False;" & _
                 "Jet OLEDB:Database Password=''"
    Cnn.Open Cnn_str
    last = Sheet1.Cells(Rows.Count, "J").End(xlUp).Row
    arr = Sheet1.Range("J6:J" & last).Value
    SQL = "Select 序号,发票号码,凭证号码,金额 From 发票信息"
    rs.Open SQL, Cnn_str, 1, 3
    'GetRows 方法 将 Recordset 对象的多个记录复制到数组中。
    '语法：array = recordset.GetRows( Rows, Start, Fields )
    '返回：二维数组。
    brr = rs.GetRows(, , "发票号码")

'    For i = 0 To UBound(brr, 2)
'        Sheet4.Range("b" & i + 1) = brr(0, i)
'
'    Next
    rs.MoveFirst
    For i = 0 To UBound(brr, 2)
        For j = 1 To UBound(arr)
            If arr(j, 1) = brr(0, i) Then
            MsgBox arr(j, 1)
            End If
        Next j
    Next i

    Cnn.Close
    rs.Close
    Set Cnn = Nothing
    Set rs = Nothing
End Sub