VBA Auto Executor
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
Download this class: macroautox.cls
Amazon

