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 c
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.
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#