求指教，求滴蜡，求精简

If Text2 = "" Then
    MsgBox "请填写完整"
Else
Set db = New ADODB.Connection
db.CursorLocation = adUseClient
db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source= " + App.Path + "/hengshi.mdb;Persist Security Info=False"
Set rs = New ADODB.Recordset
For i = 1 To 4
rs.Open "select * from mychuhuo where chbianhao=" & i & "", db, adOpenStatic, adLockOptimistic
     Label4 = rs("chbianhao")
     Label5 = rs("chmc")
     Label6 = rs("chsl")
     
     Set db2 = New ADODB.Connection
    db2.CursorLocation = adUseClient
    db2.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source= " + App.Path + "/hengshi.mdb;Persist Security Info=False"
    Set rs2 = New ADODB.Recordset
    rs2.Open "select * from  kucun where kpinzhong='" & Label5 & "'", db2, adOpenStatic, adLockOptimistic
    If Not rs2.EOF Then
            MsgBox "找到" + Label5
                If Label6 <= rs2("kshuliang") Then
                    MsgBox Label5 + "可以出货"
                    rs.Close
                    If i = 4 Then
                        
                        MsgBox "全部检验成功,开始出货"
                        Set db3 = New ADODB.Connection
                        db3.CursorLocation = adUseClient
                        db3.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source= " + App.Path + "/hengshi.mdb;Persist Security Info=False"
                        Set rs3 = New ADODB.Recordset
                        For q = 1 To 4
                        '
                        rs3.Open "select * from mychuhuo where chbianhao=" & q & "", db3, adOpenStatic, adLockOptimistic
                        Label4 = rs3("chbianhao")
                        Label5 = rs3("chmc")
                        Label6 = rs3("chsl")                        Set db1 = New ADODB.Connection
                        db1.CursorLocation = adUseClient
                        db1.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source= " + App.Path + "/hengshi.mdb;Persist Security Info=False"
                        Set rs1 = New ADODB.Recordset
                        rs1.Open "select * from  kucun where kpinzhong='" & Label5 & "'", db, adOpenStatic, adLockOptimistic
                        db1.Execute "update kucun set kshuliang='" & rs1("kshuliang") - Val(Label6) * Val(Text2) & "' where kpinzhong='" & Label5 & "'"
                        Print Label4 + " " + Label5 + "...成功-"; Val(Label6) * Val(Text17)
                        Next q                    End If
                Else
                    MsgBox Label5 + "库存不够"
                    Exit For
                End If
            
        Else
            MsgBox "找不到" + Label5
            Exit For
        End If
Next iEnd If停在rs3.open
提示数据库打开时不能操作，
求指教，求精简