|
问题:逐条写入数据库,判断发票号码是否与数据库中的发票发码(主键)重复,以下代码能捕获Err.Number信息,但是循环写下一行,没有重复的发票号码,VBA也报相同的错误代码(见截图),找不到原因,请高手帮忙解决!
代码:
- Sub 写入_发票信息()
- Dim i1%, i2%, i3%, i4%, i5%, i6%, i7%, k%, j As Long, n As Long
- Dim cnn As Object, rs As Object, SQL$
- Dim wb As Workbook
- Dim ws As Worksheet
- Set wb = ThisWorkbook
- Set ws = wb.ActiveSheet
- i1 = Excel.Application.WorksheetFunction.Match("序号", ws.Rows(4), 0) '序号所在的列数
- i2 = Excel.Application.WorksheetFunction.Match("发票号码", ws.Rows(4), 0) '发票号码所在的列数
- i3 = Excel.Application.WorksheetFunction.Match("凭证号码", ws.Rows(4), 0) '凭证号码所在的列数
- i4 = Excel.Application.WorksheetFunction.Match("名称及规格", ws.Rows(4), 0) '凭证号码所在的列数
- i5 = Excel.Application.WorksheetFunction.Match("购置时间", ws.Rows(4), 0) '购置时间所在的列数
- i6 = Excel.Application.WorksheetFunction.Match("数量", ws.Rows(4), 0) '数量所在的列数
- i7 = Excel.Application.WorksheetFunction.Match("金额", ws.Rows(4), 0) '金额所在的列数
- j = ws.Cells(Rows.Count, i2).End(xlUp).Row
- '没有数据则退出
- If j < 6 Then
- MsgBox "没有数据!"
- Exit Sub
- End If
- Set cnn = CreateObject("adodb.connection")
- Set rs = CreateObject("adodb.recordset")
- '建立与数据库链接
- With cnn
- .provider = "microsoft.ace.oledb.12.0"
- .connectionstring = "data source=" & "E:\CTA信息管理" & "" & "技改数据.accdb"
- .Open
- End With
- '删除数据
- SQL = "delete from 发票信息 where ID = '" & Sheets("基本信息").Range("c4") & "'"
- cnn.Execute SQL
- SQL = "select * from 发票信息 where ID = '" & Sheets("基本信息").Range("c4") & "'"
- rs.Open SQL, cnn, 1, 3
- On Error Resume Next
- Sheets("重号发票清单").UsedRange.ClearContents
- Sheets("重号发票清单").Range("a1:d1") = Array("序号", "发票号", "凭证号码", "金额")
- n = 6
- Do While n <= j
- rs.AddNew
- rs.Fields("发票号码").Value = ws.Cells(n, i2).Value
- rs.Fields("ID").Value = Sheets("基本信息").Cells(4, 3).Value
- rs.Fields("序号").Value = Int(ws.Cells(n, i1).Value)
- rs.Fields("凭证号码").Value = ws.Cells(n, i3).Value
- rs.Fields("名称及规格").Value = ws.Cells(n, i4).Value
- rs.Fields("购置时间").Value = ws.Cells(n, i5).Value
- rs.Fields("数量").Value = ws.Cells(n, i6).Value
- rs.Fields("金额").Value = ws.Cells(n, i7).Value
- rs.Update
- If Err.Number = -2147217887 Then
- k = k + 1
- MsgBox "发票重号,所在行号为:" & n & Chr(10) & Chr(10) _
- & "错误代码:" & Err.Number & Chr(10) _
- & "错误提示:" & Err.Description
- Err.Clear
-
- With Sheets("重号发票清单")
- .Range("a" & k + 1) = ws.Cells(n, i1).Value
- .Range("b" & k + 1) = ws.Cells(n, i2).Value
- .Range("c" & k + 1) = ws.Cells(n, i3).Value
- .Range("d" & k + 1) = ws.Cells(n, i7).Value
- End With
- End If
- n = n + 1
- Loop
- 'myout:
- '
- ' If Err.Number = -2147217887 Then
- ' MsgBox "发票重号,所在行号为" & n
- '
- ' Else
- ' MsgBox "其他错误,错误代码:" & Err.Number & ",错误内容:" & Err.Description
- '
- ' End If
- ' Resume Next
- 'MsgBox Err.Description '错误的描述
- MsgBox "数据保存完毕!", vbInformation + vbOKOnly
- rs.Close
- cnn.Close
- Set rs = Nothing
- Set cnn = Nothing
- Set wb = Nothing
- Set ws = Nothing
- End Sub
复制代码
数据表
EXCEL文件
错误提示
错误提示
|
|