VBA-Module regelmäßig sichern per COM-Add-In

Wer viel in VBA programmiert, kennt den Schreck: Ein Absturz von Access, und die Arbeit der letzten halben Stunde ist weg. Natürlich kann man von Hand speichern – aber genau das vergisst man im Eifer des Gefechts. In diesem Beitrag bauen wir uns einen fleißigen Helfer, der uns diese Sorge abnimmt: ein COM-Add-In für den Access-Entwickler, das in einstellbaren Abständen alle geänderten Formulare, Berichte und Module automatisch in einzelne Textdateien sichert. So haben wir immer eine frische Kopie unseres Codes zur Hand, ganz ohne daran zu denken.

Was der Helfer leisten soll

Bevor wir in den Code schauen, halten wir kurz fest, was das Add-In eigentlich tun soll. In regelmäßigen Abständen – zum Beispiel alle fünf Minuten – sieht es nach, welche Module im aktuellen Projekt seit dem letzten Speichern geändert wurden. Jedes solche Modul schreibt es als eigene Textdatei in einen Unterordner namens BAS. Damit dabei nicht bei jedem Durchlauf sämtliche Module erneut gesichert werden, merkt sich das Add-In für jedes Modul einen kleinen Fingerabdruck des Inhalts und legt nur dann eine neue Datei an, wenn sich wirklich etwas geändert hat.

Bedienen lässt sich der Helfer bequem über einen eigenen Bereich im Datei-Menü des VBA-Editors. Dort schalten wir die automatische Sicherung ein und aus, wählen das Zeitintervall und sehen auf einen Blick, welche Dateien zuletzt gesichert wurden. Wie dieser Bereich aussieht, zeigt Bild 1.

Bild 1: Das COM-Add-In amvCodeBackup im Dateinmenü von Access

In Bild 2 sehen Sie, wie das Intervall zum Exportieren der geänderten VBA-Module ausgewählt wird.

Bild 2: Auswählen des Intervalls zum Anlegen von Sicherungen

Ein kleiner Wermutstropfen

Das Sichern bezieht sich nicht nur auf reine VBA-Module – auch wenn der Code in den Klassenmodulen von Formularen oder Berichten geändert wurden, werden diese gespeichert.

Wenn allerdings der Code eines Formulars oder Berichts geändert wurde, muss dieses vor dem Exportieren der neuen Version zunächst gespeichert werden – daher erscheint in diesem Fall jeweils eine Meldung wie die aus Bild 3.

Bild 3: Meldung vor dem Speichern von Formularen oder Berichten

Damit dies beim Programmieren nicht zu sehr stört, empfiehlt es sich, das Intervall entsprechend hochzusetzen. Welches Intervall für Sie optimal funktioniert, probieren Sie am besten selbst aus. Ein kleineres Intervall bringt diese Meldung öfter hervor, ein größeres ist mit dem Risiko behaftet, dass bei einem Absturz von Access eventuell mehr Änderungen verloren gehen.

Das Projekt in twinBASIC

Wie in früheren Beiträgen entsteht das COM-Add-In mit twinBASIC, das für die 32-Bit-Version kostenlos ist. Wie man ein solches Projekt von Grund auf anlegt, haben wir bereits an anderer Stelle gezeigt; hier konzentrieren wir uns darauf, wie das fertige Projekt amvCodeBackup und der darin enthaltene Code funktionieren. Am bequemsten öffnen Sie die mitgelieferte Projektdatei und verfolgen die Bausteine parallel zum Beitrag.

Das Projekt gliedert sich in drei Teile. Die Klasse amvCodeBackup steuert den gesamten Ablauf. Das Modul mdlTimer verbindet den Windows-Wecker mit der Sicherungsroutine, und das Modul DllRegistration macht das Add-In gegenüber Access bekannt. Diese drei Teile gehen wir nun der Reihe nach durch.

Der Kopf der Klasse

Ganz oben in der Klasse amvCodeBackup steht die ClassId, eine weltweit einmalige Nummer, unter der Windows das Add-In in der Registry wiederfindet. Sie wird von twinBASIC einmalig vergeben und danach nicht mehr angetastet, denn eine geänderte Nummer gälte als ein gänzlich anderes Objekt. Direkt darunter meldet die Klasse die beiden Bausteine an, die sie umsetzt. Hier sehen wir den Kopf der Klasse:

[ClassId("DC8E7154-FAC8-43B7-88E5-A9352753999F")]
Class amvCodeBackup
    Implements IDTExtensibility2
    [WithDispatchForwarding]
    Implements IRibbonExtensibility

Eine Schnittstelle legt fest, welche Prozeduren eine Klasse bereitstellen muss. Über IDTExtensibility2 kann Office das Add-In starten und wieder beenden, und IRibbonExtensibility öffnet uns den Weg, dem Menüband eigene Elemente hinzuzufügen. Die Angabe WithDispatchForwarding in eckigen Klammern ist eine technische Markierung, die twinBASIC für das Ribbon benötigt.

Was sich die Klasse merkt

Damit der Helfer arbeiten kann, hält er mehrere Verweise fest. Hier sehen wir diese im Überblick:

Private objAccess As Access.Application
Private objVBE As VBIDE.VBE
Private cbbCodeBackup As Object
Private objRibbon As IRibbonUI
Private WithEvents cbbCodeBackupEvents As VBIDE.CommandBarEvents
Private cbbCodeBackupOptionen As Object
Private WithEvents cbbCodeBackupOptionenEvents As VBIDE.CommandBarEvents

In objAccess liegt später Access selbst, in objVBE der VBA-Editor mit seinen Projekten und Modulen – an ihn wenden wir uns, um an den Quellcode zu gelangen. In objRibbon merken wir uns das Menüband, um seine Anzeige bei Bedarf auffrischen zu können. Die vier übrigen Variablen gehören zu zwei Einträgen, die wir zusätzlich in die Symbolleiste des Editors setzen: cbbCodeBackup zum Ein- und Ausschalten und cbbCodeBackupOptionen zum Einstellen des Intervalls. Das Schlüsselwort WithEvents sorgt jeweils dafür, dass wir auf Klicks reagieren können.

Ein Wecker aus Windows

Um in festen Abständen aktiv zu werden, borgt sich der Helfer eine Uhr von Windows. Die Funktion SetTimer stellt einen Wecker, der nach der eingestellten Zeit auslöst, KillTimer schaltet ihn wieder ab. Weil Access in einer 32- und einer 64-Bit-Version existiert und diese Funktionen dort geringfügig anders angesprochen werden, sind sie doppelt vereinbart. Welche Fassung gilt, entscheidet bereits beim Kompilieren die Abfrage #If Win64 Then (siehe Listing 1).

#If Win64 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _
        ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private lngTimerID As LongPtr
#Else
    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
    Private lngTimerID As Long
#End If

Listing 1: Die Timer-Funktionen werden je nach Architektur passend deklariert

SetTimer liefert eine Kennnummer für den laufenden Wecker zurück, die wir in lngTimerID ablegen. Solange sie ungleich null ist, wissen wir, dass der Timer arbeitet – ein bequemer Weg, den Ein-/Aus-Zustand abzufragen.

Das Intervall dauerhaft merken

Das gewählte Intervall soll einen Neustart von Access überdauern, deshalb legen wir es in der Registry ab. Unter welchem Namen und in welchem Abschnitt der Wert liegt, halten ein paar Konstanten fest; fehlt noch ein gespeicherter Wert, greifen 300 Sekunden als Vorgabe. Die Konstanten dazu sehen wir folgt aus:

Private Const REG_APP As String = "amvCodeBackup"
Private Const REG_SECTION As String = "Optionen"
Private Const REG_INTERVALL As String = "Intervall"
Private Const REG_INTERVALL_DEFAULT As Long = 300
Private Const MAX_RECENT As Integer = 10

Das eigentliche Lesen und Schreiben übernehmen zwei winzige Prozeduren, die sich der fertigen VBA-Funktionen GetSetting und SaveSetting bedienen. Mehr als der gespeicherte Sekundenwert wandert hier nicht über die Leitung, wie folgende Listings belegen:

Private Function IntervallLesen() As Long
    IntervallLesen = CLng(GetSetting(REG_APP, REG_SECTION, _
        REG_INTERVALL, REG_INTERVALL_DEFAULT))
End Function
Private Sub IntervallSchreiben(lngSekunden As Long)
    SaveSetting REG_APP, REG_SECTION, REG_INTERVALL, _
        lngSekunden
End Sub

Die Konstante MAX_RECENT aus dem vorigen Listing legt übrigens fest, wie viele der zuletzt gesicherten Dateien wir später in der Liste anzeigen – hier also zehn.

Die Oberfläche als XML beschreiben

Der Bereich im Datei-Menü wird nicht zusammengeklickt, sondern als XML beschrieben. Die Funktion GetCustomUI setzt diesen Text Zeile für Zeile zusammen und reicht ihn an Office weiter. Der Vorteil dieser Trennung: Das XML bestimmt allein das Aussehen und die Anordnung, während der eigentliche Inhalt später aus dem Code kommt. Die Definition zeigt Listing 2.

Private Function GetCustomUI(ByVal RibbonID As String) As String Implements IRibbonExtensibility.GetCustomUI
    Dim strXML As String
    Dim i As Integer
    strXML = "<customUI xmlns=""http://schemas.microsoft.com/office/2009/07/customui"" onLoad=""customUI_OnLoad"">" & vbCrLf
    strXML = strXML & "  <backstage>" & vbCrLf
    strXML = strXML & "    <tab id=""tabCodeBackup"" label=""amvCodeBackup"" insertAfterMso=""TabInfo"" " _
        & "title=""amvCodeBackup"">" & vbCrLf
    strXML = strXML & "      <firstColumn>" & vbCrLf
    strXML = strXML & "        <group id=""grpTimer"" label=""Timer"">" & vbCrLf
    strXML = strXML & "          <topItems>" & vbCrLf
    strXML = strXML & "            <button id=""btnTimer"" getLabel=""btnTimer_GetLabel"" " _
        & "onAction=""btnTimer_OnAction""/>" & vbCrLf
    strXML = strXML & "            <dropDown id=""ddIntervall"" label=""Intervall"" " _
        & "getSelectedItemIndex=""ddIntervall_GetSelectedItemIndex"" onAction=""ddIntervall_OnAction"">" & vbCrLf
    strXML = strXML & "              <item id=""i10"" label=""10 Sekunden""/>" & vbCrLf
    strXML = strXML & "              <item id=""i20"" label=""20 Sekunden""/>" & vbCrLf
    strXML = strXML & "              <item id=""i30"" label=""30 Sekunden""/>" & vbCrLf
    strXML = strXML & "              <item id=""i60"" label=""1 Minute""/>" & vbCrLf
    strXML = strXML & "              <item id=""i120"" label=""2 Minuten""/>" & vbCrLf
    strXML = strXML & "              <item id=""i300"" label=""5 Minuten""/>" & vbCrLf
    strXML = strXML & "              <item id=""i600"" label=""10 Minuten""/>" & vbCrLf
    strXML = strXML & "            </dropDown>" & vbCrLf
    strXML = strXML & "          </topItems>" & vbCrLf
    strXML = strXML & "        </group>" & vbCrLf
    strXML = strXML & "        <group id=""grpRecent"" label=""Zuletzt gesichert"">" & vbCrLf
    strXML = strXML & "          <topItems>" & vbCrLf
    For i = 1 To MAX_RECENT
        strXML = strXML & "            <labelControl id=""lblRecent" & i & """ getLabel=""lblRecent" & i _
            & "_GetLabel""/>" & vbCrLf
    Next i
    strXML = strXML & "          </topItems>" & vbCrLf
    strXML = strXML & "        </group>" & vbCrLf
    strXML = strXML & "      </firstColumn>" & vbCrLf
    strXML = strXML & "    </tab>" & vbCrLf
    strXML = strXML & "  </backstage>" & vbCrLf
    strXML = strXML & "</customUI>" & vbCrLf
    GetCustomUI = strXML
End Function

Listing 2: Die Funktion GetCustomUI liefert die Ribbon-Definition.

Das äußerste Element customUI klammert alles ein und nennt über onLoad die Prozedur, die Office einmal aufruft, sobald die Oberfläche geladen ist. Darin folgt backstage – jener Bereich, der beim Klick auf Datei erscheint. Mit tab legen wir dort eine eigene Seite an und schieben sie über insertAfterMso hinter den vorhandenen Bereich. Die erste Gruppe grpTimer enthält die Schaltfläche btnTimer zum Umschalten und das Auswahlfeld ddIntervall mit den festen Zeitstufen. Jedes Element nennt dabei die Funktionen, die es mit Leben füllen – etwa getLabel für die Beschriftung und onAction für die Reaktion auf einen Klick.

Die zweite Gruppe listet die zuletzt gesicherten Dateien auf. Weil es davon zehn sind, wäre es mühsam, jede Zeile von Hand zu schreiben – eine Schleife erzeugt sie stattdessen.

Jede Zeile erhält eine eigene Kennung von lblRecent1 bis lblRecent10 und nennt über getLabel die Funktion, die ihren Text liefert. Danach schließt die Definition Gruppe, Spalte, Seite und Bereich wieder ordentlich, und die fertige Zeichenkette geht zurück an Office.

Das Menüband greifbar halten

Sobald Office unsere Oberfläche geladen hat, ruft es die in onLoad genannte Funktion auf. Sie tut nur eines, ist aber wichtig: Sie merkt sich das übergebene Menüband in objRibbon:

Public Sub customUI_OnLoad(ByVal ribbon As IRibbonUI)
    Set objRibbon = ribbon
End Sub

Über diesen gemerkten Verweis können wir später einzelne Steuerelemente auffrischen lassen – etwa die Beschriftung der Umschalt-Schaltfläche, sobald sich der Zustand ändert, oder die ganze Liste der letzten Sicherungen, wenn eine neue Datei hinzugekommen ist.

Woher die Liste der letzten Sicherungen kommt

Jede der zehn Listenzeilen fragt beim Anzeigen ihre Beschriftung ab. Damit dafür nicht zehn fast gleiche Funktionen nötig sind, reichen sie ihre Nummer an eine gemeinsame Helferin namens GetRecentLabel weiter. Diese liest alle Sicherungsdateien im BAS-Ordner ein und ordnet sie nach Datum, sodass die neueste obenauf liegt. Den Kern dieser Sortierung hält Listing 3 fest.

Private Function GetRecentLabel(intPos As Integer) As String
    Dim strFolder As String, strFile As String, colFiles() As String, intCount As Integer
    Dim i As Integer, j As Integer, strTemp As String, dtTemp As Date, dtFile As Date
    Dim strFullName As String, dtMod As Date, objVBProject As VBIDE.VBProject
    Set objVBProject = GetVBProject()
    If objVBProject Is Nothing Then
        GetRecentLabel = ""
        Exit Function
    End If
    strFolder = Left(objVBProject.FileName, InStrRev(objVBProject.FileName, "\")) & "BAS"
    If Dir(strFolder, vbDirectory) = "" Then
        GetRecentLabel = ""
        Exit Function
    End If
    ReDim colFiles(0)
    intCount = 0
    strFile = Dir(strFolder & "\*.bas")
    Do While strFile <> ""
        ReDim Preserve colFiles(intCount)
        colFiles(intCount) = strFile
        intCount = intCount + 1
        strFile = Dir()
    Loop
    If intCount = 0 Then
        GetRecentLabel = ""
        Exit Function
    End If
    For i = 0 To intCount - 2
        For j = 0 To intCount - 2 - i
            If FileDateTime(strFolder & "\" & colFiles(j)) < FileDateTime(strFolder & "\" & colFiles(j + 1)) Then
                strTemp = colFiles(j)
                colFiles(j) = colFiles(j + 1)
                colFiles(j + 1) = strTemp
            End If
        Next j
    Next i
    If intPos > intCount Then
        GetRecentLabel = ""
    Else
        strFullName = colFiles(intPos - 1)
        dtMod = FileDateTime(strFolder & "\" & strFullName)
        GetRecentLabel = Format(dtMod, "DD.MM.YY HH:NN:SS") & "  " & strFullName
    End If
End Function

Listing 3: Die Sicherungsdateien werden nach Datum geordnet, die jüngste zuerst

Zum Einsatz kommt hier das Bubble-Sort-Verfahren: Es vergleicht immer zwei benachbarte Dateien und vertauscht sie, falls die ältere vor der jüngeren steht. Nach einigen Durchgängen wandert so die neueste Datei nach oben. Zur gewünschten Position liefert die Funktion anschließend Datum, Uhrzeit und Dateinamen zurück – oder einen leeren Text, falls es noch nicht so viele Sicherungen gibt.

Das Auswahlfeld für das Intervall

Damit das Auswahlfeld beim Öffnen die richtige Stufe hervorhebt, führt der Code die sieben möglichen Werte in einem kleinen Feld. Beim Anzeigen sucht er darin den gespeicherten Wert und meldet dessen Position zurück, sodass genau diese Stufe vorausgewählt erscheint:

Private intervallWerte(6) As Long
Private Sub IntervallWerteInitialisieren()
    intervallWerte(0) = 10 : intervallWerte(1) = 20
    intervallWerte(2) = 30 : intervallWerte(3) = 60
    intervallWerte(4) = 120 : intervallWerte(5) = 300
    intervallWerte(6) = 600
End Sub
Public Function ddIntervall_GetSelectedItemIndex( _
        ByVal control As IRibbonControl) As Integer
    IntervallWerteInitialisieren()
    Dim intAktuell As Integer, i As Integer
    intAktuell = IntervallLesen()
    For i = 0 To UBound(intervallWerte)
        If intervallWerte(i) = intAktuell Then
            ddIntervall_GetSelectedItemIndex = i
            Exit Function
        End If
    Next i
    ddIntervall_GetSelectedItemIndex = 5
End Function

Wählt der Benutzer eine andere Stufe, tritt ddIntervall_OnAction auf den Plan: Die Prozedur schreibt den neuen Wert in die Registry und startet einen laufenden Timer mit dem geänderten Intervall neu, damit die Umstellung sofort greift.

Ein- und ausschalten über die Schaltfläche

Die Umschalt-Schaltfläche kennt zwei Aufgaben. Zum einen liefert sie über btnTimer_GetLabel ihre eigene Beschriftung, die je nach Zustand „aktivieren“ oder „deaktivieren“ lautet. Zum anderen schaltet btnTimer_OnAction beim Klick zwischen an und aus um und frischt danach die Anzeige auf. Beide Routinen sehen wir hier:

Public Function btnTimer_GetLabel(control As _
        IRibbonControl) As String
    If TimerLaeuft() Then
        btnTimer_GetLabel = "Code-Backup deaktivieren"
    Else
        btnTimer_GetLabel = "Code-Backup aktivieren"
    End If
End Function
Public Sub btnTimer_OnAction(control As IRibbonControl)
    If TimerLaeuft() Then
        TimerStoppen()
    Else
        TimerStarten()
    End If
    objRibbon.Invalidate
End Sub

Der Aufruf objRibbon.Invalidate am Ende ist der Grund, warum wir uns das Menüband zuvor gemerkt haben: Er weist Office an, die Anzeige neu aufzubauen, sodass die Schaltfläche sofort ihre aktualisierte Beschriftung zeigt.