VBAモジュールの終了

Question

定期的に実行されるVBAスクリプトがあります。タイムベースに応じて、別のモジュールを実行します。私が以前に経験したことのない問題は、モジュールが早すぎて終了するように見えることです。それは私の方法に疑問を投げかけている。モジュールが実行された条件に関係なく、終了したり、終了したりするまで、module.subは終了または終了しないと私は理解しています。私が間違っている？

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

これは実行が行くために起こっているかである。 1.割り当て1 4までの値を持つタイムベース（タイムベースが作成されていることを前提と秒が作成され、グローバルに設定） 2. select文は、timeBaseの値に応じて1回実行されます。 3. End Selectに到達し、selectステートメントが終了します。 4. End Subに達し、サブが終了します。

サブを繰り返し実行する場合は、for（）ループまたはwhile（）ループで囲むことができます。

Answer 2

問題を発見しましたが、VBエラーが発生しないと心配します。問題は、SQLセルのいくつかがnullである可能性があり、タグ変数にnull値を代入しようとすると、情報なしでモジュールが終了するだけです。