大家帮忙看看这段代码哪里出错了,???

Question

Private Sub XPButton9_Click()
Dim rstReport As New Recordset
Dim rstCustomer As New Recordset
Dim rstConnent1 As New Recordset
Dim intOrder As Long '序号变量
Dim BeginNum, EndNum As String
Dim FirstFund As Double
Dim NumberP As Long
Dim strCustomer As String
Dim strCompent As String
On Error GoTo Errpro
NumberP = 0
FirstFund = 0
BeginNum = ""
EndNum = ""Set rstConnent1 = New ADODB.Recordset
    rstConnent1.CursorType = adOpenDynamic
    rstConnent1.LockType = adLockOptimistic
    FillRecordset "select * from V_NotConnent where province <> '浙江省' order by Employee,ConnentDate DESC ", rstConnent1    If Not (rstConnent1.EOF And rstConnent1.BOF) Then
            If Combo2.ListIndex = 1 Then
               vBookMark = ReturnMarkArray1
               If vBookMark(0) = "no" Then
                    Exit Sub
                Else
                    rstConnent1.Filter = vBookMark
                End If
            End If
                With rstReport
                    .CursorLocation = adUseClient
                    .CursorType = adOpenDynamic
                    .LockType = adLockBatchOptimistic
                    .Fields.Append "ProgramID", adBigInt
                    .Fields.Append "ProgramCode", adVarChar, 50
                    .Fields.Append "Program", adVarChar, 100
                    .Fields.Append "Number", adBigInt
                    .Fields.Append "DeviseUnit", adVarChar, 100
                    .Fields.Append "Designer", adVarChar, 50
                    .Fields.Append "Employee", adVarChar, 50
                    .Fields.Append "ConnentDate", adDate
                    .Open
'                End If
                End With
                
'                MsgBox rstReport.Supports(adAddNew)Label5Label6
'                DataReport1.Sections("Section5").Controls("Label6").Caption = Text2(0).Text
                rstConnent1.MoveFirst
                strCustomer = IIf(IsNull(rstConnent1.Fields("Connent").Value), "", rstConnent1.Fields("Connent").Value)
                Set rstCustomer = New ADODB.Recordset
                rstCustomer.CursorType = adOpenDynamic
                rstCustomer.LockType = adLockOptimistic
                FillRecordset "select LawMan,Customer from tb_Customer where LawMan='" & strCustomer & "'", rstCustomer
                If Not (rstCustomer.EOF And rstCustomer.BOF) Then
                If strCustomer <> "" And rstCustomer.Fields("Customer").Value <> "" Then
                strCompent = rstCustomer.Fields("Customer").Value
                DataReport17.Sections("Section5").Controls("Label5").Caption = strCompent & "(接单负责人签字并回传此单" & ")："
                Else
                strCompent = ""
                End If
                End If
               Set rstCustomer = Nothing
                EndNum = IIf(IsNull(rstConnent1.Fields("ProgramCode").Value), "    ", rstConnent1.Fields("ProgramCode").Value)
                intOrder = 1
                rstConnent1.MoveLast
                BeginNum = IIf(IsNull(rstConnent1.Fields("ProgramCode").Value), "    ", rstConnent1.Fields("ProgramCode").Value)
                Do While Not rstConnent1.BOF
                     With rstReport
                        .AddNew
                        .Fields("ProgramID").Value = intOrder
                        .Fields("ProgramCode").Value = IIf(IsNull(rstConnent1.Fields("ProgramCode").Value), "", rstConnent1.Fields("ProgramCode").Value)
                        .Fields("Program").Value = IIf(IsNull(rstConnent1.Fields("Program").Value), "", rstConnent1.Fields("Program").Value)
                        .Fields("Number").Value = IIf(IsNull(rstConnent1.Fields("Number").Value), 0, rstConnent1.Fields("Number").Value)
                        .Fields("DeviseUnit").Value = IIf(IsNull(rstConnent1.Fields("DeviseUnit").Value), "", rstConnent1.Fields("DeviseUnit").Value)
                        .Fields("Designer").Value = IIf(IsNull(rstConnent1.Fields("Designer").Value), "", rstConnent1.Fields("Designer").Value)
                        .Fields("Employee").Value = IIf(IsNull(rstConnent1.Fields("Employee").Value), "", rstConnent1.Fields("Employee").Value)
                        .Fields("ConnentDate").Value = IIf(IsNull(rstConnent1.Fields("ConnentDate").Value), "", rstConnent1.Fields("ConnentDate").Value)
                       NumberP = NumberP + IIf(IsNull(rstConnent1.Fields("Number").Value), 0, rstConnent1.Fields("Number").Value)
'                       FirstFund = FirstFund + IIf(IsNull(rstConnent.Fields("FirstMoney").Value), 0, rstConnent.Fields("FirstMoney").Value)
                     End With
                     intOrder = intOrder + 1
                     rstConnent1.MovePrevious
                LoopACRptEngine2.Init
'ACRptEngine2.addvariavblle "咨询进展表打印", Trim(Text1.Text)
ACRptEngine2.AddDataSet "tb_NotConnent", rstReport
ACRptEngine2.AddDataSetRelation "tb_NotConnent", "V_NotConnent", "ProgramID=ProgramID"
ACRptEngine2.SetReportFile ReportPath + "list4.apt"
If Check7.Value = 1 Then
ACRptEngine2.ShowDesigner
Else
ACRptEngine2.Preview
End If
Set rstConnent1 = Nothing
Set rstReport = Nothing
Else
MsgBox "没有记录,请录入数据", vbCritical, "系统提示"
End IfEnd Sub
Errpro:
    MsgBox Err.Description, vbCritical, "系统提示："
    Set rstReport = Nothing
End Sub'标签
Private Function ReturnMarkArray1() As Variant
Dim vArray() As Variant
Dim ArraySize As Integer
Dim Flag As Boolean
Dim i As Long
i = 1
ArraySize = 0
     rstConnent1.MoveFirst
     With rstConnent1
        Do While Not rstConnent1.EOF
           If Trim(VSFConnent.TextMatrix(i, 0)) = "打印" Then
               If ArraySize <> 0 Then
                  ReDim Preserve vArray(ArraySize) As Variant
               Else
                  ReDim vArray(0) As Variant
               End If
               vArray(ArraySize) = rstConnent1.Book
               If Flag = False Then
                   Flag = True
               End If
               ArraySize = UBound(vArray) + 1
           End If
           rstConnent1.MoveNext
           i = i + 1
        Loop
     End With
     If Flag = False Then
        ReDim vArray(0) As Variant
        vArray(0) = "no"
     End If
     ReturnMarkArray1 = vArray
End Function
出错提示是 标签未定义,,而我定义了一个全局的,,,高手支招啊,,,感激不尽,,

Answer 1

把END改成exit就好了
If Check7.Value = 1 Then 
ACRptEngine2.ShowDesigner 
Else 
ACRptEngine2.Preview 
End If 
Set rstConnent1 = Nothing 
Set rstReport = Nothing 
Else 
MsgBox "没有记录,请录入数据", vbCritical, "系统提示" 
End If End Sub 
Errpro: 
    MsgBox Err.Description, vbCritical, "系统提示：" 
    Set rstReport = Nothing 
End Sub