Run a macro exactly 5 minutes after a different macro ends

问题

The following code runs different macros at specific times but sometimes they run into each other and make for the whole process to be excruciating long. I was wondering how I could run the macros labeled "MASTER" exactly 5 minutes after the macro before it is done instead of just having them on scheduled times.

Sub Workbook_Open()

If Weekday(Date) >= 2 And Weekday(Date) < 7 Then
    
    Application.OnTime TimeValue("15:14:00"), "MarketClose3"
    Application.OnTime TimeValue("17:15:00"), "Saveit"
    Application.OnTime TimeValue("17:18:00"), "MASTER"
    Application.OnTime TimeValue("17:34:00"), "MASTER"
    Application.OnTime TimeValue("17:50:00"), "MASTER"
    Application.OnTime TimeValue("18:06:00"), "MASTER"
    Application.OnTime TimeValue("18:22:00"), "MASTER"
    Application.OnTime TimeValue("18:38:00"), "MASTER"
    Application.OnTime TimeValue("18:54:00"), "MASTER"
    Application.OnTime TimeValue("19:10:00"), "SORT"
End If
    
End Sub

回答1:

Effectively you want async/await in VBA. There isn't one, but it's not difficult to implement a dumbed down version yourself.

In a class module called MacroSequence:

Option Explicit

Private m_Macros As Variant
Private m_Pause As Date

Private m_LastScheduledIndex As Long
Private m_LastScheduledTime As Date

Private m_OnTimeNextStepName As String


Friend Sub Init(macros As Variant, ByVal FirstRunTime As Date, ByVal PauseBetweenEach As Date)
  If Len(m_OnTimeNextStepName) <> 0 Then Err.Raise 5, , "You may only init this once"
  If PauseBetweenEach <= 0 Then Err.Raise 5, , "Invalid interval between macros"
  If Not IsArray(macros) Then Err.Raise 5, , "Array of strings expected for 'macros'"
  
  m_Macros = macros
  m_Pause = PauseBetweenEach
  
  m_LastScheduledIndex = LBound(m_Macros)
  m_LastScheduledTime = FirstRunTime
  
  m_OnTimeNextStepName = "'StateMachine.NextStep " & LTrim$(Str$(ObjPtr(Me))) & "'"
  
  Application.OnTime m_LastScheduledTime, m_OnTimeNextStepName
End Sub

Public Function NextStep() As Boolean
  Application.Run m_Macros(m_LastScheduledIndex)
  
  m_LastScheduledIndex = m_LastScheduledIndex + 1
  
  If m_LastScheduledIndex <= UBound(m_Macros) Then
    NextStep = True
    m_LastScheduledTime = Now + m_Pause
    Application.OnTime m_LastScheduledTime, m_OnTimeNextStepName
  End If
End Function

Public Sub Cancel()
  If Len(m_OnTimeNextStepName) = 0 Then
    Err.Raise 5, , "Has not been initialized"
  Else
    Application.OnTime m_LastScheduledTime, m_OnTimeNextStepName, , False
  End If
End Sub

In a standard module called StateMachine:

Option Explicit

Private m_Sequences As New Collection

Public Function StartNewSequence(macros As Variant, ByVal FirstRunTime As Date, ByVal PauseBetweenEach As Date) As String
  Dim s As MacroSequence
  Set s = New MacroSequence
  
  StartNewSequence = LTrim$(Str$(ObjPtr(s)))
  
  m_Sequences.Add s, StartNewSequence
  s.Init macros, FirstRunTime, PauseBetweenEach
End Function

Public Sub CancelSequence(ByVal SequenceId As String)
  m_Sequences(SequenceId).Cancel
End Sub

Public Sub NextStep(ByVal SequenceId As String)
  If Not m_Sequences(SequenceId).NextStep Then m_Sequences.Remove SequenceId
End Sub

Use:

StateMachine.StartNewSequence Array("MarketClose3", "Saveit", "MASTER", "MASTER", "MASTER", "MASTER", "MASTER", "MASTER", "MASTER", "SORT"), #15:40:00#, #00:05:00#

回答2:

I had a similar issue a long time ago.

What I did was have each macro create a temporary file with a completed code.

When the next macro starts it checks for the completed code and if it is not there it waited 10 seconds and checked again.

Worked at treat.

来源：https://stackoverflow.com/questions/64729175/run-a-macro-exactly-5-minutes-after-a-different-macro-ends

标签

excel

vba

time