VBA代码优化

哪位大神帮我修改下代码，我想把On Error Resume Next去除，记录集为空时有可能出现错误,如果用goto类代码会太多。

Public Sub 对接成功()
    On Error Resume Next
    Dim db As DAO.Database
    Dim rs1 As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim fd1 As DAO.Field
    Dim fd2 As DAO.Field
    Dim fd3 As DAO.Field
    Dim fd4 As DAO.Field
    Dim str1 As String
    Dim str2 As String
    Set db = CurrentDb()
    
    '下面是信用证中的以发票号为基础，查找的对接成功；
    '---------------------------------------------------------------------------------------
    Set rs1 = db.OpenRecordset("select * from [发票信息表] where [对接成功]=false")
    rs1.MoveFirst
    Set fd1 = rs1.Fields(1)  '提取【发票信息表】中的发票号
    Set fd3 = rs1.Fields(3)  '提取【发票信息表】中的对接成功
    rs1.MoveFirst
    Do Until rs1.EOF
        str1 = fd1.Value
        Set rs2 = db.OpenRecordset("select * from [报关单信息表] where [发票号]=" & sqltext(str1))
        Set fd4 = rs2.Fields(0)   '提取【报关信息表】中的对接成功
        rs2.MoveFirst
        Do Until rs2.EOF
            rs1.Edit
            fd3.Value = True
            rs1.Update
            rs2.Edit
            fd4.Value = True
            rs2.Update
            rs2.MoveNext
        Loop
        rs1.MoveNext
    Loop
    
    '下面是以报关单为基础，查找的对接成功
    '-----------------------------------------------------------------------------------
    Set rs1 = db.OpenRecordset("select * from [报关单信息表] where [对接成功]=false")
    rs1.MoveFirst
    Set fd1 = rs1.Fields(2)  '提取【报关单信息表】中的发票号
    Set fd2 = rs1.Fields(0)  '提取【报关单信息表】中的对接成功
    rs1.MoveFirst
    Do Until rs1.EOF
       str1 = fd1.Value
       Set rs2 = db.OpenRecordset("select * from [发票信息表] where [发票号]=" & sqltext(str1))
       Set fd3 = rs2.Fields(3)     '提取[发票信息表]中的对接成功
       rs2.MoveFirst
       Do Until rs2.EOF
            rs1.Edit
            fd2.Value = True
            rs1.Update              '修改【报关单信息表】中的对接成功
            rs2.Edit
            fd3.Value = True
            rs2.Update              '修改[发票信息表]中的对接成功
            rs2.MoveNext
       Loop
       rs1.MoveNext
    Loop
    
    rs1.Close
    rs2.Close
    db.Close
    Set rs1 = Nothing
    Set rs2 = Nothing
    Set db = Nothing
End Sub