Timer ohne Formular mit VBA programmieren

1/2026, 2026, Outlook programmieren, VBA-Programmierung, Visual Basic Programmierung

Möchtest Du den gesamten Artikel lesen? Und vielleicht sogar den Artikel im PDF-Format und die Beispieldateien herunterladen? Dann hole Dir den Artikel gleich hier - völlig kostenlos!

Unter Access kennt man eigentlich nur den Timer, den das Formular-Objekt mitbringt. Damit können wir ein Ereignis definieren, das in einem bestimmten Zeitintervall ausgelöst wird. Was aber, wenn wir einen Timer einmal außerhalb des Kontexts eines Formulars benötigen? Dann erstellen wir uns einfach eine eigene Timer-Klasse. Dazu sind zwar ein paar Tricks und API-Funktionen nötig, aber das soll kein Hindernis sein. Deshalb zeigen wir in diesem Beitrag im Detail, wie das gelingt und wie sich dieser Timer in der Praxis einsetzen lässt. Und im Gegensatz zum Formulartimer haben wir noch einen Vorteil: Wir können nämlich nicht nur einen, sondern beliebig viele Timer einsetzen und laufen lassen.

Klassischer Formular-Timer in Access

Wenn wir in Access einen Timer benötigen, ist das eigentlich nur über den Formular-Timer möglich. Dazu fügt man einem Formular das Ereignis Bei Zeitgeber hinzu und legt mit der Eigenschaft Zeitgeberintervall fest, in welchen Intervallen dieses Ereignis ausgelöst werden soll (siehe Bild 1).

Einfacher Formulartimer

Bild 1: Einfacher Formulartimer

In der Ereignisprozedur tragen wir den Code ein, der beim Eintreten des Ereignisses Form_Timer ausgelöst werden soll. In diesem Fall aktualisieren wir alle 1.000 Millisekunden die Anzeige der Uhrzeit:

Private Sub Form_Timer()
    Me.txtUhrzeit = Time()
End Sub

Wenn der Timer nicht mehr ausgelöst werden soll, stellen wir die Eigenschaft Zeitgeberintervall per VBA auf 0 ein:

Me.TimerInterval = 0

Wenn mehr als ein Timer benötigt wird …

Ein Timer ist allerdings manchmal nicht ausreichend. Wenn man nicht mehrere Formulare mit einem Timer ausstatten will, muss man sich also eine andere Lösung überlegen. Außerdem gibt es auch Anwendungsfälle, in denen gerade kein Formular geöffnet ist, das den Timer zur Verfügung stellen kann. Was ist zum Beispiel, wenn man regelmäßig einen bestimmten Status im Ribbon aktualisieren möchte?

Für solche Anwendungsfälle stellen wir nun eine Lösung vor, mit der wir bis zu 100 Timer unabhängig voneinander starten, auslösen und beenden können.

Dazu benötigen wir eine Klasse, die den Timer selbst enthält. Zudem benötigen wir ein paar Zeilen Code, um die Timer zu initialisieren und die dadurch ausgelösten Ereignisse zu implementieren.

Die Klasse CLS_AMV_Timer

Die Klasse, welche die Timer bereitstellt, heißt CLS_AMV_Timer und ist in Listing 1 zu finden. Sie deklariert zunächst das Ereignis, das durch den Timer ausgelöst wird:

Public Event TimerEvent()
Private L_INTERVAL As Long
Private L_ID As LongPtr
Friend Sub ErrRaise(E As Long)
    Dim sText As String
    Dim sSource As String
    If E > 1000 Then
        sSource = "Application" & ".WindowProc"
        Select Case E
            Case eTooManyTimers
                sText = "No more than 1000 timers allowed per class"
            Case eCantCreateTimer
                sText = "Can''t create system timer"
        End Select
        Err.Raise E Or vbObjectError, sSource, sText
    Else
        Err.Raise E, sSource
    End If        
End Sub
Property Get Interval() As Long
    Interval = L_INTERVAL
End Property
Property Let Interval(lValue As Long)
    Dim b As Boolean        
    If lValue > 0 Then
        If L_INTERVAL = lValue Then Exit Property
        If L_INTERVAL Then
            b = TimerDestroy(Me)
            Debug.Assert b
        End If
        L_INTERVAL = lValue
        If TimerCreate(Me) = False Then
            ErrRaise eCantCreateTimer
        End If
    Else
        If (L_INTERVAL > 0) Then
            L_INTERVAL = 0
            b = TimerDestroy(Me)
            Debug.Assert b
        End If
    End If        
End Property
Public Sub RaiseInterval()
    RaiseEvent TimerEvent
End Sub
Friend Property Get TimerID() As LongPtr
    TimerID = L_ID
End Property
Friend Property Let TimerID(ID As LongPtr)
    L_ID = ID
End Property
Private Sub Class_Terminate()
    Interval = 0
End Sub

Listing 1: Klassenmodul CLS_AMV_Timer

Public Event TimerEvent()

Die Variablen L_INTERVAL und L_ID speichern das Intervall eines Timers und die ID:

Private L_INTERVAL As Long
Private L_ID As LongPtr

Die Prozedur ErrRaise wird beim Auftreten eines Fehlers aufgerufen.

Über die Property Get-Prozedur Interval können wir das Intervall eines Timers abrufen, mit der entsprechenden Property Let-Prozedur setzen wir das Intervall.

Dabei übergeben wir die Anzahl der Millisekunden, nach denen der Timer ausgelöst werden soll. Die Prozedur prüft, ob das Intervall größer als 0 ist, und stellt dieses ein. Wenn das zugewiesene Intervall gleich dem zuvor eingestellten Intervall ist, wird die Prozedur verlassen. Anderenfalls rufen wir die Prozedur TimerDestroy auf, die im Standardmodul MDL_AMV_Timer enthalten ist (siehe weiter unten).

Die Methode RaiseInterval löst das Ereignis TimerEvent aus, das wir im implementierenden Klassenmodul definieren. Schließlich gibt es noch zwei Property-Prozeduren, mit denen die TimerID gelesen und geschrieben werden kann, und die Methode Class_Terminate, welche das Intervall auf 0 Millisekunden einstellt.

Private Sub Class_Terminate()
    Interval = 0
End Sub

Damit kommen wir zum zweiten Modul, das für die Verwendung der Klasse wichtig ist.

Modul MOD_AMV_TIMER: Verwaltung der Timer

Das Modul MOD_AMV_TIMER enthält alle Funktionen, um die Windows-Timer zu starten und zu stoppen. Es sorgt dafür, dass bis zu 100 Timer gleichzeitig verwaltet werden können. Diese enthält zunächst einige Deklarationen (siehe Listing 2).

Public Enum eTimerError
    eBaseTimer = 10100
    eTooManyTimers = 10101
    eCantCreateTimer = 10102
End Enum
#If Win64 Then
    Public Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _
        ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Public Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
    Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, _
        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
#End If
Private Const cTimerMax As Long = 100
Private aTimers(1 To cTimerMax) As CLS_AMV_TIMER
Private cTimerCount As Integer

Listing 2: Deklarationen im Modul MDL_AMV_Timer

Diese Deklarationen stellen sicher, dass wir die Windows-Timer-API sowohl in 32-Bit- als auch in 64-Bit-Umgebungen verwenden können. Das Enum eTimerError definiert eigene Fehlercodes für die Klasse.

cTimerMax legt die maximale Anzahl gleichzeitig laufender Timer fest. Das Array aTimers speichert Referenzen auf alle Timer-Objekte. cTimerCount gibt an, wie viele Timer aktuell verwendet werden.

Timer erstellen

In der Funktion TimerCreate wird der Windows-Timer über die API-Funktion SetTimer erstellt (siehe Listing 3).

Public Function TimerCreate(Timer As CLS_AMV_TIMER) As Boolean
    Dim i As Integer
    On Error Resume Next
    Timer.TimerID = SetTimer(CLngPtr(0), CLngPtr(0), Timer.Interval, AddressOf TimerProc)
    If Timer.TimerID Then
        TimerCreate = True
        For i = 1 To cTimerMax
            If aTimers(i) Is Nothing Then
                Set aTimers(i) = Timer
                If i > cTimerCount Then cTimerCount = i
                Exit Function
            End If
        Next
        Timer.ErrRaise eTooManyTimers
    Else
        Timer.TimerID = 0
        Timer.Interval = 0
    End If
End Function

Listing 3: Die Funktion TimerCreate

Anschließend suchen wir einen freien Platz im Array aTimers. Bei Erfolg speichern wir das Objekt, andernfalls wird ein Fehler geworfen.

Timer zerstören

Diese Funktion TimerDestroy sucht im Array den passenden Timer anhand der ID, beendet ihn mit KillTimer und entfernt die Referenz (siehe Listing 4).

Public Function TimerDestroy(Timer As CLS_AMV_TIMER) As Long
    Dim i As Integer, f As Boolean
    On Error Resume Next
    For i = 1 To cTimerCount
        If Not aTimers(i) Is Nothing Then
            If Timer.TimerID = aTimers(i).TimerID Then
                f = KillTimer(CLngPtr(0), Timer.TimerID)
                Set aTimers(i) = Nothing
                TimerDestroy = True
                Exit Function
            End If
        End If
    Next
End Function

Listing 4: Die Funktion TimerDestroy

Ende des frei verfügbaren Teil. Wenn Du mehr lesen möchtest, hole Dir ...

den kompletten Artikel im PDF-Format mit Beispieldatenbank

diesen und alle anderen Artikel mit dem Jahresabo

Schreibe einen Kommentar