預定的VBA任務和“ Application.OnTime”

Question

我有以下運行良好的VBA代碼。 它正在調用另一個VBA Sub而沒有任何麻煩：

Public Sub AutoPrintMissingHistoric()
    Dim qdf As DAO.QueryDef
    Dim rcs As DAO.Recordset
    Dim db As DAO.Database
    Dim j As Integer
    Dim flag As Boolean
    Dim i As Long
    Dim value_start, value_end As String
    Dim tmp As Date
    Dim wbRiskedge As Workbook
    Dim wsAccueil As Worksheet
    Dim wsHistoric As Worksheet

    Set wbRiskedge = Workbooks(StrWbRiskedge)
    Set wsAccueil = wbRiskedge.Worksheets(StrWsAccueil)
    Set wsHistoric = wbRiskedge.Worksheets(StrWsHistoricMissing)
    If FistTime = True Then
        Call Initialisation.CleanTab
    Else
        FistTime = True
        Call Initialisation.Initialisation
    End If
    vDelay = 5
    Cpt = Cpt + 1
    Set db = DBEngine.OpenDatabase(strDB)
    Set qdf = db.QueryDefs("Get_missing_fixings")
    If Cpt <= wsAccueil.Range(ManualListLetter & "1").End(xlDown).Row Then
        Application.StatusBar = wsAccueil.Cells(Cpt, ManualListLetter).Text
        qdf.Parameters("arg1") = wsAccueil.Cells(Cpt, ManualListLetter).Value
        Set rcs = qdf.OpenRecordset
        j = 0
        i = 1
        flag = False
        If Not rcs.EOF Then
            rcs.MoveLast
            rcs.MoveFirst
            While Not rcs.EOF
                j = 0
                While j < rcs.Fields.Count
                    If flag = False Then
                        With Cells(i, j + 1)
                            If .Value = "" Then
                                .Value = rcs(j).Name
                                .Font.Bold = True
                                .HorizontalAlignment = xlCenter
                                .VerticalAlignment = xlBottom
                            End If
                        End With
                    Else
                        Cells(i, j + 1).Value = rcs(j).Value
                    End If
                    j = j + 1
                Wend
                If flag = False Then
                    flag = True
                End If
                i = i + 1
                rcs.MoveNext
            Wend
            Call ChangeMinMax(rcs.RecordCount, CellMinDate, CellMaxDate, wsHistoric)
            Call ParseParameters
            Call SetReutersFunction
        End If
        rcs.Close
        qdf.Close
        db.Close
        wsHistoric.Calculate
        Application.StatusBar = wsAccueil.Cells(Cpt, ManualListLetter).Text & " - Next Function: FindMissingValue.AutoFindMissingValue"
        sToCall = "FindMissingValue.AutoFindMissingValue"
        MTimeGT = Time + TimeValue("00:00:" & vDelay)
        Application.OnTime MTimeGT, sToCall
    End If
End Sub

我將此過程的執行安排在預定的任務中。 但是顯然我的代碼執行得不好： FindMissingValue.AutoFindMissingValue Sub不會被調用，因為Excel只是關閉了。

我認為這是因為Application.OnTime MTimeGT, sToCall ...可能是什么原因？

在這里，您具有FindMissingValue.AutoFindMissingValue的代碼

Sub AutoFindMissingValue()
    Dim wbRiskedge As Workbook
    Dim wsAccueil As Worksheet
    Dim wsHistoric As Worksheet
    Dim i, nbResult As Long

    Set wbRiskedge = Workbooks(StrWbRiskedge)
    Set wsAccueil = wbRiskedge.Worksheets(StrWsAccueil)
    Set wsHistoric = wbRiskedge.Worksheets(StrWsHistoricMissing)
    If Left(wsHistoric.Range(ReutersFormula).Text, 13) Like "Retrieving...*" = True Then
        sToCall = "FindMissingValue.AutoFindMissingValue"
        MTimeGT = Time + TimeValue("00:00:05")
        Application.OnTime MTimeGT, sToCall
        Exit Sub
    End If
    i = WorksheetFunction.CountA(Columns(DateColumn & ":" & DateColumn))
    If WorksheetFunction.CountA(Columns(ColumnResearchVResult & ":" & ColumnResearchVResult)) > 0 Then
        wsHistoric.Range(FirstCellResearchVResult & ":" & ColumnResearchVResult & WorksheetFunction.CountA(Columns(ColumnResearchVResult & ":" & ColumnResearchVResult))).ClearContents
    End If
    nbResult = wsHistoric.Range(FirstResult).End(xlDown).Row
    wsHistoric.Range(ColumnResearchVResult & LineResearchVResult - 1).Value = "Results"
    If WorksheetFunction.CountA(Columns(DateColumn & ":" & DateColumn)) > 1 Then
        wsHistoric.Range(FirstCellResearchVResult & ":" & ColumnResearchVResult & i).FormulaLocal = "=RECHERCHEV($" & DateColumn & "$" & LineResearchVResult & ":$" & DateColumn & "$" & i & ";" & FirstLockResult & ":$" & ValueResultColumn & "$" & nbResult & ";2;0)"
    End If
    Application.StatusBar = wsAccueil.Cells(Cpt, ManualListLetter).Text & " - Next Function: FindMissingValue.AutoPutResultInDb"
    sToCall = "FindMissingValue.AutoPutResultInDb"
    MTimeGT = Time + TimeValue("00:00:01")
    Application.OnTime MTimeGT, sToCall
End Sub

Answer 1

Application.OnTime部分是正確的，應該沒有任何問題（5秒后）調用FindMissingValue.AutoFindMissingValue 。 可能發生的情況是，在這5秒鍾的時間內，代碼繼續運行，返回到調用AutoPrintMissingHistoric ，並且在這5秒鍾過去之前，工作簿可能已關閉（盡管根據您的實際情況，該功能應該即使工作簿已關閉也被調用）。

您可以縮短等待時間（例如vDelay = 1 ），也可以直接調用函數（ Call FindMissingValue.AutoFindMissingValue ）。 實際上，我不確定為什么要依靠Application.OnTime來調用該函數； 使用此方法可以“啟動進程”（例如，“我希望我的宏每天在00:00執行”），但如果經常使用，可能會導致“混亂”。

如果以上方法均FindMissingValue.AutoFindMissingValue ，請提供FindMissingValue.AutoFindMissingValue的代碼進行查看。

注意：經過一些進一步的測試/討論，我可以確認OnTime在這些特定條件下的行為“太不規則”。 您應該想出一種不同的方法來允許您需要的等待時間，或者在必須依靠OnTime情況下，進行大量的反復試驗以確保其行為完全受到控制。 預期該函數將被調用一次（例如，在特定時間打開電子表格），因此，在不同的上下文中使用它時（例如在函數內部調用它），您必須特別注意。