VBA-Modul-Terminierung

Question

Ich habe ein VBA-Skript, das regelmäßig ausgeführt wird. Abhängig von der Zeitbasis wird ein anderes Modul ausgeführt. Ein Problem, in das ich hineingerannt bin, das ich vorher noch nicht erlebt habe, ist, dass das Modul vorzeitig zu beenden scheint. Es lässt mich meine Methoden in Frage stellen. Es versteht sich von selbst, dass ein Modul nicht beendet oder beendet wird, bis es beendet oder beendet wird, unabhängig davon, in welcher Bedingung das Modul lief. Liege ich falsch?

Private Sub tmr1Sec_Change() 
    timeBase = seconds Mod 5 'Set a 4 second time base 
Select Case timeBase 
       Case 1 To 2 
        errorPosition = "ThisDisplay.tmr1Sec_Change.machineState 2.1" 
         Call aofResults.orderPoll ' 
       Case 2 To 3 
        errorPosition = "ThisDisplay.tmr1Sec_Change.machineState 2.2" 
         If orderExists = True Then 'Set by the orderPoll Module 
          Call aofResults.linePoll 
         End If 
       Case 3 To 4 
       Case Else 
      End Select 
End Sub 

aofResults.linePoll

Public Sub linePoll() 
    errorPosition = "aofResults.linePoll" 
    On Error GoTo errorTrap 
    Err.Clear 
    Dim rst As ADODB.Recordset 
    Dim rstA As ADODB.Recordset 
    Dim rstB As ADODB.Recordset 
    Dim rstC As ADODB.Recordset 
    Dim rstD As ADODB.Recordset 
    Dim rstE As ADODB.Recordset 
    Dim packQty As Integer 
    Dim m As Integer 
    Dim formFactor As Integer 
    m = 0 
    constr = "Provider=sqloledb;data source=xxxxxxxxxxxxxx;initial catalog=xxxxxxxxxxxxxxxx;user id=xxxxxxxxxxx;password=xxxxxxxxxxx" 
    'set the machine to recieve state 
    Set conn = New ADODB.connection 
    Set cmd = New ADODB.Command 
    conn.Open constr 
    cmd.ActiveConnection = conn 
    cmd.CommandText = "SELECT SUM(lQ.[QUANTITY]) FROM [AOF_ORDER_LINE_QUEUE] AS lQ LEFT JOIN [AOF_ORDER_QUEUE] AS oQ ON lQ.[SALES_ORDER_NUMBER] = oQ.[SALES_ORDER_NUMBER]" 
    Set rst = cmd.Execute      'Get total order quantity, may change if inventory depletes. 
    Set eTag = ThisDisplay.eGroup.Item("AOF\soQuantity") 
    eTag.value = rst(0) 
    cmd.CommandText = "SELECT Count(rL.SERIAL_NUMBER) FROM [AOF_OPTIC_RESULTS] AS rL WHERE EXISTS (SELECT [SO_LINE_NUMBER] FROM [AOF_ORDER_LINE_QUEUE] AS lQ LEFT JOIN [AOF_ORDER_QUEUE] AS oQ ON lQ.[SALES_ORDER_NUMBER] = oQ.SALES_ORDER_NUMBER) AND [REJECT] = 0" 
    Set rst = cmd.Execute 
    Set eTag = ThisDisplay.eGroup.Item("AOF\soQuantityPacked") 
    eTag.value = rst(0) 
    Set eTag = ThisDisplay.eGroup.Item("Machine\itoSettings0") 'Evaluate packing quantity against machine settings (stored in DB, written to PLC at first startup) 
    If rst(0) < eTag.value Then 
     Set eTag = ThisDisplay.eGroup.Item("AOF\manualPack") 'Evaluate packing quantity 
     eTag.value = True 
    Else 
     eTag.value = False 
    End If 
    rst.Close 
    cmd.CommandText = "SELECT lQ.[SO_LINE_NUMBER],lQ.[QUANTITY],lQ.[SELECTED],lQ.[FORM_FACTOR_ID], lQ.[FINISHED_PART_NUMBER], lQ.[OEM_PART_NUMBER],lQ.[COMPATIBILITY], oQ.[INDIVIDUAL_PACKAGING], oQ.[SALES_ORDER_NUMBER] FROM [AOF_ORDER_QUEUE] AS oQ LEFT JOIN [AOF_ORDER_LINE_QUEUE] AS lQ ON oQ.[SALES_ORDER_NUMBER] = lQ.[SALES_ORDER_NUMBER] WHERE lQ.[SO_LINE_NUMBER] IS NOT NULL ORDER BY lQ.[SELECTED] DESC,lQ.[COMPLETED] ASC" 
    Set rstA = cmd.Execute()      'Returns the line orders associated to the sales order 
    If Not rstA.EOF = True Then 
     Set eTag = ThisDisplay.eGroup.Item("AOF\SOLineNumber") 
     eTag.value = rstA(0) 
     Set eTag = ThisDisplay.eGroup.Item("AOF\QuantityOrdered") 
     eTag.value = rstA(1) 
     Set eTag = ThisDisplay.eGroup.Item("AOF\FinishedPartNumber") 
     eTag.value = rstA(4) 
     Set eTag = ThisDisplay.eGroup.Item("AOF\OEMPartNumber") 
     eTag.value = rstA(5) 
     Set eTag = ThisDisplay.eGroup.Item("AOF\Compatibility") 
     eTag.value = rstA(6) 
     Set eTag = ThisDisplay.eGroup.Item("AOF\IndividualPack") 
     eTag.value = rstA(7) 
     cmd.CommandText = "SELECT COUNT(rL.SERIAL_NUMBER) FROM [AOF_OPTIC_RESULTS] AS rL LEFT JOIN [AOF_ORDER_OPTICS] AS oL ON oL.[SERIAL_NUMBER] = rL.[SERIAL_NUMBER] WHERE rL.REJECT = 0 AND oL.[SO_LINE_NUMBER] = " & rstA(0) & "" 
     Set rstB = cmd.Execute()     'Returns the count of the parts associated to the above line order that passed 
     If Not rstB.EOF = True Then 
      Set eTag = ThisDisplay.eGroup.Item("AOF\QuantityPassed") 
      eTag.value = rstB(0) 
      Select Case rstA(1) - rstB(0)  'Evaluate Qty left to process in active line order 
      Case Is = 0       'Qty Zero (Line order complete) 
       cmd.CommandText = "SELECT COUNT(lQ.[COMPLETED]) FROM [AOF_ORDER_LINE_QUEUE] AS lQ LEFT JOIN [AOF_ORDER_QUEUE] AS oQ ON oQ.[SALES_ORDER_NUMBER] = lQ.[SALES_ORDER_NUMBER] WHERE oQ.[SELECTED] = 'True'" 
       Set rstD = cmd.Execute()     'Check line queue quantity associated to the sales order, count the line orders associated to the current sales order in the queue 
       cmd.CommandText = "UPDATE [AOF_ORDER_LINE_QUEUE] SET [SELECTED] = 'False' WHERE [SO_LINE_NUMBER] = " & rstA(0) & "" 
       cmd.Execute      'Unselect the currently index line order 
       cmd.CommandText = "UPDATE [AOF_ORDER_LINE_QUEUE] SET [COMPLETED] = 'True' WHERE [SO_LINE_NUMBER] = " & rstA(0) & "" 
       cmd.Execute      'Set order as completed 
       'Set the currently indexed line order as selected 
       If rstD(0) <> 0 Then 
        cmd.CommandText = "SELECT COUNT(lQ.[COMPLETED]) FROM [AOF_ORDER_LINE_QUEUE] AS lQ LEFT JOIN [AOF_ORDER_QUEUE] AS oQ ON oQ.[SALES_ORDER_NUMBER] = lQ.[SALES_ORDER_NUMBER] WHERE oQ.[SELECTED] = 'True' AND [COMPLETED] = 'True'" 
        Set rstE = cmd.Execute()    'count the line orders marked completed 
        If rstD(0) = rstE(0) Then   'if the line queue count matches the line queue completed count complete the order 
         Set eTag = ThisDisplay.eGroup.Item("AOF\orderFulfillmentMode") 'Checks that order fulfillment mode is turned off 
         If eTag.value = True Then 
          boxNum = 0 
          cmd.CommandText = "UPDATE [AOF_ORDER_QUEUE] SET [SELECTED] = 'False' WHERE [SALES_ORDER_NUMBER] = '" & rstA(9) & "'" 
          cmd.Execute 'Set's the current sales order selected bit to off 
          cmd.CommandText = "UPDATE [MACHINE_STATE] SET [STATUS] = 'ERP' where [OPERATING_STATE] = 2" 
          cmd.Execute 'sets the status back to ERP 
          cmd.CommandText = "DELETE FROM [AOF_OPTIC_RESULTS]" 
          cmd.Execute 
          Set eTag = ThisDisplay.eGroup.Item("AOF\soFinished") 
          eTag.value = True 
         End If 
        End If 
        rstE.Close 
       Else 
        rstA.MoveNext     'Index to the next line order in the record set 
        cmd.CommandText = "UPDATE [AOF_ORDER_LINE_QUEUE] SET [SELECTED] = 'True' WHERE [SO_LINE_NUMBER] = " & rstA(0) & "" 
        cmd.Execute 
       End If 
       rstD.Close 

      Case Is > 0       'Qty Remaining > Line Order Qty (Line Order Select) 
       cmd.CommandText = "SELECT fF.[FORM_FACTOR_DESCRIPTION] FROM [FORM_FACTOR] AS fF LEFT JOIN [AOF_ORDER_LINE_QUEUE] AS lQ ON lQ.[FORM_FACTOR_ID] = fF.[FORM_FACTOR_ID] WHERE lQ.[SELECTED] = 'True'" 
       Set rstC = cmd.Execute()   'Returns the form factor description that is currently selected in the order line queue 
       If Not rstC.EOF = True Then 
        Set eTag = ThisDisplay.eGroup.Item("AOF\FormFactor") 
        eTag.value = rstC(0) 
        Set eTag = ThisDisplay.eGroup.Item("AOF\NextOpticXFP") 
        Select Case rstC(0) 
        Case Is = "XFP" 
         eTag.value = True 
        Case Is <> "XFP" 
         eTag.value = False 
        End Select 
       End If 
       rstC.Close 
       cmd.CommandText = "UPDATE [AOF_ORDER_LINE_QUEUE] SET [SELECTED] = 'True' WHERE [SO_LINE_NUMBER] = " & rstA(0) & "" 
       cmd.Execute      'Set line as selected 
       cmd.CommandText = "SELECT oL.[SERIAL_NUMBER],ol.[RACK],ol.[TRAY],ol.[POSITION] FROM [AOF_ORDER_OPTICS] oL WHERE NOT EXISTS (SELECT * FROM [AOF_OPTIC_RESULTS] rL WHERE oL.[SERIAL_NUMBER] = rL.[SERIAL_NUMBER]) AND oL.[SO_LINE_NUMBER] = " & rstA(0) & "" 
       Set rstE = cmd.Execute   'Pull in the top level serial number and location for the next optic that doesn't exist in this line order 
       If Not rstE.EOF = True Then 
        Set eTag = ThisDisplay.eGroup.Item("AOF\NextOpticSerNo") 
        eTag.value = rstE(0) 
        Set eTag = ThisDisplay.eGroup.Item("AOF\NextOpticStk") 
        eTag.value = rstE(1) 
        Set eTag = ThisDisplay.eGroup.Item("AOF\NextOpticTry") 
        eTag.value = rstE(2) 
        Set eTag = ThisDisplay.eGroup.Item("AOF\NextOpticPsn") 
        eTag.value = rstE(3) 
        Set eTag = ThisDisplay.eGroup.Item("AOF\ITO_OpticsReady") 
        eTag.value = True 
       Else 
        MsgBox ("Error: No optics associated with line order " & rstA(0) & " exist in database") 
       End If 
       rstE.Close 
      Case Else 
      End Select 
     Else 
      MsgBox ("Error: No line orders exist for sales order " & rstA(4) & ".") 
     End If 
    ElseIf rstA.EOF = True Then 
     MsgBox ("Error: No sales order exists or no line orders associated to sales order: " & rstA(4) & " exists.") 
    End If 
    conn.Close 
cleanExit: 
    ' If Not rst Is Nothing Then rst.Close 
    ' If Not rstA Is Nothing Then rstA.Close 
    ' If Not rstB Is Nothing Then rstB.Close 
    ' If Not rstC Is Nothing Then rstC.Close 
    ' If Not rstD Is Nothing Then rstD.Close 
    ' If Not rstE Is Nothing Then rstE.Close 
    ' If Not conn Is Nothing Then conn.Close 
    Exit Sub 

errorTrap: 
    LogDiagnosticsMessage "_Eventwatcher.gfx, Position: " & errorPosition & " , Error Code: [ " & Hex(Err.number) & "], Description: " & Err.Description & "" 
' Set ThisDisplay.eGroup = Nothing 
' Set eTag = Nothing 
    Resume cleanExit 

End Sub 

Answer 1

Dies ist, wie die Ausführung gehen wird: 1. Weisen Zeitbasis mit einem Wert von 1 bis 4 (vorausgesetzt, dass Zeitbasis erstellt und Sekunden erstellt und global gesetzt) ​​ 2. Die select-Anweisung wird einmal ausgeführt, abhängig vom Wert von timeBase. 3. End Select ist erreicht und die Select-Anweisung wird beendet. 4. End Sub ist erreicht und der Subcomputer ist beendet.

Wenn Sie möchten, dass das Sub wiederholt ausgeführt wird, können Sie es in einer Schleife for() oder while() umgeben.

Answer 2

Ich entdeckte das Problem, obwohl ich mir sorge, dass es keinen Vb-Fehler wirft. Das Problem besteht darin, dass einige der SQL-Zellen "null" sein können, und wenn ich versuche, einer Tag-Variablen einen Nullwert zuzuweisen, wird das Modul ohne weitere Informationen verlassen.