Computer FAQs & Tips

Home » Programming » VBA Auto Executor

VBA Auto Executor

24 August 2008

Sometimes when you need to execute a task every period of time and there's no straight predefined function that you can just call and use with a few lines of codes. You will actually need to implement your own module.

I've written this nice class module sometime ago and I believe it will be useful for other VB/VBA developer out there. This class is an Auto Executor, it will automatically call and run a defined Routine.

It will solve the problem in the scenario above and it is written in an object oriented style which you can just embedded the whole class in your project and when you need to use it, just create the instance of it then call the public sub routine to perform the task.

How to use it

Create a Class module in your VB/VBA project call it MacroAutoX
Copy and paste the source code from here
See Completed Usage Example below
When you want to end the job, just call EndXRoutine to end the task

You also need to understand CallByName Function

CallByName(object, procname, calltype,[args()])

where

object - Required; Variant (Object). The name of the object on which the function will be executed.
procname - Required; Variant (String). A string expression containing the name of a property or method of the object.
calltype - Required; Constant. A constant of type vbCallType representing the type of procedure being called.
args() - Optional: Variant (Array).

See Visual Basic Help if you need detailed explanation. You can press F1 while cursor is on keyword.

Completed Usage Example

Public Function MyCallBackRoutine() As Long
    CallByName Me, "MyMainJobSubroutine", VbMethod
End Function
 
Private Function AutoMyCallBackRoutine(ByVal EventID As Long, _
                                       ByVal SystemTime As Long) As Long
    UF_MyForm.MyCallBackRoutine
End Function
 
Public Sub SetAutoTask(Interval As Integer)
' Call this Sub whenever you need to start your auto task
    Dim iError As Integer
    Dim MAutoX As New MacroAutoX
    MAutoX.RemoteRountine = RoutineVal(AddressOf AutoMyCallBackRoutine)
    MAutoX.TimeInterval = 60 * MAutoX.ONESECOND
    iError = MAutoX.StartXRoutine
End Sub

Source Code

Calss Module: MacroAutoX

' --------------------------------------------------------------------------------------------
' Class:        MacroAutoX
' Description:  This class is an Auto Executor. It will automatically call and run Routine
'               defined in Property "RemoteRountine"
'
' Author:       Manet Yim ( manet.yim at gmail dot com )
' Date Create:  23 Jun 2007
' Version:      1.0
' --------------------------------------------------------------------------------------------

Option Explicit
 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
   (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Private Declare Function SetTimer Lib "user32" _
   (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
 
Private Declare Function KillTimer Lib "user32" _
   (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
 
' Window Class name for "Microsoft Office Word" is OpusApp
Private Const C_WINDOW_CLASSNAME = "OpusApp"
 
' Time in different units
Private Const ONE_SECOND As Single = 1000
Private Const ONE_MINUTE As Single = ONE_SECOND * 60
Private Const ONE_HOUR As Single = ONE_MINUTE * 60
 
' Remote Routine to be called and execute
Private RemoteCallBackRountine As Long
' Time interval for auto execution
Private AutoTimeInterval As Long
 
' ID of timer at runtime
Public TimerID As Long
 
Public Property Get ONESECOND()
    ONESECOND = ONE_SECOND
End Property
 
Public Property Get ONEMINUTE()
    ONEMINUTE = ONE_MINUTE
End Property
 
Public Property Get ONEHOUR()
    ONEHOUR = ONE_HOUR
End Property
 
Public Property Let RemoteRountine(RRoutine As Long)
    RemoteCallBackRountine = RRoutine
End Property
 
Public Property Get RemoteRountine() As Long
    RemoteRountine = RemoteCallBackRountine
End Property
 
Public Property Let TimeInterval(Interval As Long)
    AutoTimeInterval = Interval
End Property
 
Public Property Get TimeInterval() As Long
    TimeInterval = AutoTimeInterval
End Property
 
Public Function StartXRoutine() As Integer
' Start executing the rountine by intitiating the Timer.
' It will run every "Interval" time sepcified.
' Interval time to be specified in number of Second
    TimerID = SetTimer(hWnd:=FindWindow(C_WINDOW_CLASSNAME, Application.Caption), _
                nIDEvent:=0, uElapse:=TimeInterval, lpTimerFunc:=RemoteCallBackRountine)
 
Finally:
    ' If error occur during starting the time and routine, return the Err Object
    ' otherwise return Nothing
    StartXRoutine = Err.number
End Function
 
Public Sub EndXRoutine()
' Ending the execution of routine by terminating the timer with reference to TimerID
    On Error Resume Next
    KillTimer hWnd:=FindWindow(C_WINDOW_CLASSNAME, Application.Caption), nIDEvent:=TimerID
End Sub