Big Numbers

comments Kommentare deaktiviert für Big Numbers
By , 30. Juli 2015

Hallo,
heute möchte ich mal über richtig große Zahlen berichten, denn VBA hat genau mit denen Probleme diese zu verarbeiten.
Gerade in der Finanzwelt z.B. bei der Berechnung von Prüfziffern werden diese benötigt. Es sind dann schon spezielle Fälle, aber man sollte wissen wie man damit umgehen kann.

Schauen wir uns mal die Datentypen an, die uns in VBA zur Verfügung stehen:
– der Long-Datentyp ist bereits mit etwas über 2,1 Milliarden überfordert.
– Double schaft es immerhin auf 15 Stellen, bevor in die gerundete Exponential-Schreibweise gewechselt wird.
– eine weitere Möglichkeit ist der wenig bekannte Dezimal-Datentyp. Dieser lässt sich mit der Funktion CDec() herstellen, und damit haben wir schon 29 Stellen mit denen wir genau rechnen können.

Aber darüber hinaus? Nichts, Nada, Niente.

Angenommen Sie möchten von einer 36-Stelligen Zahl den Modulo nehmen, denn so groß kann maximal der BBAN (Basic Bank Account Number) nämlich werden: 30 Stellen Kontoidentifikation + 4 Stellen konvertiertes Länderkürzel + „00“

Mit dividieren so wie in den vorherigen Beitrag zum Modulo kommt man da nicht weit.

Aber es gibt für solche Fälle spezielle Rechenvorschriften, und eine möchte ich euch vorstellen, die Neun-Stellen-Regel.
Diese Regel besagt folgendes:

1. Von einer großen Zahl werden von links weg 9 Ziffern genommen werden, davon der Modulo genommen.
2. Es wird eine neue Zahl gebildet die mit dem berechneten Modulo beginnt, 
   und mit Ziffern der großen Zahl bis auf 9 Stellen aufgefüllt wird.
3. Von dieser neuen Zahl wird wieder der Modulo genommen
4. Die Vorgänge 2. und 3. werden so lange wiederholt, bis alle Ziffern der ursprünglichen 
   großen Zahl verarbeitet wurden.
5. Der Modulo, der bei der letzten Berechnung herauskommt, ist das Endergebnis.

Machen wir mal ein Beispiel.
Unsere große Zahl sei diese: 661400580’9000014’5786179’5321700’131400
Der Übersichtlichkeit ist diese in die verwendeten Blöcke eingeteilt.
Davon wollen wir den Modulo 97 bestimmen:

661400580 Mod 97 = 66
669000014 Mod 97 = 35
355786179 Mod 97 = 73
735321700 Mod 97 =  8
8131400   Mod 97 = 84

Der Modulo 97 userer großen Zahl ist also 84.

Um nun nicht ständig von Hand zu rechnen, erstellen wir aus diesen Informationen eine Prozedur.
Da wir von unserer großen Zahl (Dividend) nur Ziffern abschneiden, und nicht mit ihr rechnen, können wir diese als String-Parameter übergeben.

Public Function Modulo(ByVal Dividend As String, ByVal Devisor As Long)
    Dim NeueZahl As Long
    Dim ZwischenModulo As Variant

    Do While Len(Dividend) > 0
        NeueZahl = CLng(ZwischenModulo & Left(Dividend, 9 - Len(CStr(ZwischenModulo))))
        Dividend = Mid(Dividend, 10 - Len(CStr(ZwischenModulo)))
        ZwischenModulo = NeueZahl Mod Devisor
    Loop
    Modulo = ZwischenModulo
End Function

Was euch sicherlich Kopfzerbrechen macht ist diese Zeile:
NeueZahl = CLng(ZwischenModulo & Left(Dividend, 9 – Len(CStr(ZwischenModulo))))

Im ersten Durchlauf der Schleife ist ZwischenModulo (Typ Variant) Leer bzw. Empty. Daher ist Len(CStr(Zwischenmodulo)) = 0. Es werden also genau 9 Stellen von der großen Zahl genommen.
Im zweiten und weiteren Durchläufen ist ZwischenModulo mit dem zuvor berechneten Modulo besetzt. Die NeueZahl bildet sich also aus ZwischenModulo & 9-Len(CStr(ZwischenModulo)) Stellen der großen Zahl, um wieder maximal 9 Stellen zu erhalten.

Die Zeile: Dividend = Mid(Dividend, 10 – Len(CStr(ZwischenModulo))) schneidet einfach nur die verwendeten Ziffern von der großen Zahl ab.
Da die Mid()-Funktion 1-Basiert ist, muss man Mid(Dividend,10) schreiben um 9 Stellen vom Dividend abzuschneiden, also alles richtig.

Vieleicht noch der Hinweis warum ZwischenModulo als Variant deklariert ist und nicht als Long: Wäre er als Long deklariert dann wäre im ersten Schleifendurchgang der Wert nicht Leer sondern 0, und die Länge von CStr(0) ist nunmal 1 und nicht 0.

OK, ich denke ich konnte euch die Problematiken von richtig großen Zahlen – den Big Numbers – ein wenig näher bringen. Und die neue Modulo-Funktion könnt ihr auch sofort in euren Projekten einsetzen und ihr läuft nicht Gefahr dass irgendwann der Wertebereich nicht ausreicht oder dass falsche Ergebnisse durch die gerundete Exponential-Darstellung von Double auftreten, denn diese können in der Finanzwelt schnell sehr teuer werden.

Bis dahin
© 2015 Andreas Vogt

Excel-Dokumente aus Access heraus formatieren

comments Kommentare deaktiviert für Excel-Dokumente aus Access heraus formatieren
By , 27. Juli 2015

Hallo,
angenommen ihr exportiert Daten von Access nach Excel und möchtet nach Bearbeitung das Excel-Sheet ausdrucken.
Das Anpassen der Seitenränder für den Druck kann man nämlich auch gleich aus Access heraus erledigen.
Dazu benötigen wir zuerst den Verweis auf die aktuelle Microsoft Excel Library.

Danach benötigen wir die 3 Excel-Objekte für die Anwendung, das Workbook und das Worksheet:

    Dim xlApp As Excel.Application
    Dim xlBook As Workbook
    Dim xlSheet As Worksheet

    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open("c:\output.xlsx")
    Set xlSheet = xlBook.Worksheets(1)

Das Anwendungsobjekt ist definiert, das Workbook geöffnet und der Verweiss auf das erste Arbeitsblatt gesetzt. Jetzt gehts los:

    With xlSheet.PageSetup
        .LeftHeader = "&""Arial,Standard""&8&F"
        .CenterHeader = "&""Arial,Standard""&8&A"
        .RightHeader = "&""Arial,Standard""&8&D"
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&""Arial,Standard""&8Seite &P"
        .LeftMargin = xlApp.InchesToPoints(0.5)
        .RightMargin = xlApp.InchesToPoints(0.25)
        .TopMargin = xlApp.InchesToPoints(0.75)
        .BottomMargin = xlApp.InchesToPoints(0.75)
        .HeaderMargin = xlApp.InchesToPoints(0.5)
        .FooterMargin = xlApp.InchesToPoints(0.5)
        ....
    End With

Man kann also alles einstellen was auch in Excel einzustellen geht. Zu beachten ist, dass die Angaben in Points zu machen sind. Dazu kann man die Excel-Funktion InchesToPoints() verwenden.
Seht euch die Schreibweise für die Schriftart und -Größe an. Beachtet die doppelte Anführungszeichen.
Man kann auch bequem Einstellungen wie Druckqualität, Papiergröße oder Seitenzahlen einfügen wie oben im rechten Footer.

Bis dahin
© 2015 Andreas Vogt

Datentypen und Berechnungen

comments Kommentare deaktiviert für Datentypen und Berechnungen
By , 25. Juli 2015

Hallo,
heute möchte ich euch ein paar Fallstricke zeigen in die man bei Berechnungen innerhalb VBA tappen kann.
Doch Zuvor unsere kleine Testprozedur:

Sub berechnen()
    Dim i As Long, k As Long
    i = 1 * 64000
    k = 2 * 32000
End Sub

Wir setzen auf die Prozedur einen Haltepunkt und starten sie.
Ihr werdet sehen dass i korrekt berechnet wird, aber bei k ein Überlauf-Fehler kommt.
Der Grund liegt in der Größe der Zahlen.

Macht einfach mal folgendes:
Haltepunkt setzen und Prozedur starten.
Markiert 1 * 64000, rechte Maustaste klicken und auf „Überwachung hinzufügen“ klicken.
Im Fenster für Überwachungsausdrücke seht ihr jetzt als Datentyp „Long“ stehen.
Dann macht das gleiche für 2 * 32000. Jetzt sehr ihr als Datentyp „Integer“.

Das bedeutet, dass obwohl ihr die Variablen als Long deklariert habt, die Berechnung selbst unter einem anderen Datentyp laufen kann. Access nimmt sich hier einfach die größte Zahl aus der Berechnung und ermittelt anhand deren den Datentyp. Und 32000 passt nunmal ziemlich gut in den signed Integer Wertebereich hinein.

Hier ein paar gebräuchliche Datentypen mit ihren Wertebereichen:

Byte:     -128 bis 127 bzw. unsigned von 0 bis 255
Integer:  -32768 bis 32767 bzw. unsigned von 0 bis 65535
Long:     −2.147.483.648 bis 2.147.483.647 bzw. unsignet von 0 bis 4.294.967.295

Um jetzt das ganze noch verwirrender zu machen folgende Multiplikationen:
i = 2.1 * 32000
k = 2 = 32000

Wie Wunder gibt es bei i keinen Überlauf-Fehler, bei k aber schon. Wieder als Überwachungsausdruck eingefügt zeigt der Debugger nun für 2.1 * 32000 jetzt als Datentyp Double an.
Das liegt an der Nachkommastelle, die VBA dazu bewegt hat den Double-Datentyp zu verwenden.

Um nun aber 2 * 32000 berechnen zu können gibts einfach einen Trick.
entweder man schreibt hinter die 2 das Formarzeichen „#“ oder man schreibt einfach 2.0, welches automatisch auch in ein 2# umgewandelt wird.
Werden nun aber Variablen multipliziert, so ist der deklarierte Datentyp der Variablen maßgebend.

Ihr seht, eine kleine Berechnung kann ganz schön Kopfzerbrechen verursachen, aber nun wisst ihr wie ihr das umschiffen könnt.

Bis dahin
© 2015 Andreas Vogt

IBAN für deutsche Kontos berechnen

comments Kommentare deaktiviert für IBAN für deutsche Kontos berechnen
By , 24. Juli 2015

Hallo,
im letzten Beitrag gings um Modulo-Berechnung großer Zahlen. Und genau hier bei der Berechnung des IBAN benötigen wir diese Funktion.
Der übersicht wegen hab ich diese etwas gekürzt:

Private Function Modulo(ByVal Dividend As Double, ByVal Devisor As Double) As Long
    If Devisor = 0 Then Exit Function
    Modulo = Dividend - Fix(Dividend / Devisor) * Devisor
End Function

Bekannter Weise wird der IBAN wird gebildet aus:
– 2 Ziffern für die Länderkennung
– 2 Ziffern für die Prüfziffer
– Je nach Land bis zu 30 Ziffern für die Kontoidentifikation,
meist bestehend aus Bankleitzahl und Kontonummer und ggf. weiteren Kontrolziffern.

In Deutschland besteht die Kontoidentifikation aus 8-Stelliger Bankleitzahl und auf 10 Stellen aufgefüllt mit Nullen die Kontonummer.
Wie sich diese Kontoidentifikation zusammensetzt ist bei Wikipedia nachzulesen: https://de.wikipedia.org/wiki/IBAN

Kommen wir nun zum Berechnen der Prüfziffer, weil das das einzig schwierige am IBAN ist.
Diese wird Berechnet aus Bankleitzahl und Kontonummer durch Multiplikation von 62 mit den Modulo von BLZ durch 97 addiert mit 1 und dem Modulo von Kontonummer multipliziert mit 27 durch 97
Aus diesem ganzen Ausdruck wird wiederum der Modulo-Wert durch 97 ermittelt und von 98 abgezogen.

Also ziemlich verwirrend das ganze.
Deshalb teilen wir das auf in 2 Schritte, und speichern das Zwischenergebnis in einer Hilfsvariable:
Hilfsvar1 = 62 * (1 + Modulo(Blz, 97) + Modulo(27 * Kto, 97))

Die Prüfziffer berechnet sich dann wie folgt:
98 – Modulo(Hilfsvar1, 97)

Der Rest ist dann ziemlich einfach:

Public Function IBAN(ByVal Kto As Variant, ByVal Blz As Variant) As String
    Dim Hilfsvar1 As Variant
    
    Hilfsvar1 = 62 * (1 + Modulo(Blz, 97) + Modulo(27 * Kto, 97))
    IBAN = "DE" & 98 - Modulo(Hilfsvar1, 97)
    IBAN = IBAN & Blz & Left("0000000000", 10 - Len(Kto)) & Kto
End Function

Das wars auch schon wieder für heute.

Bis dahin
© 2015 Andreas Vogt

Modulo großer Zahlen berechnen

comments Kommentare deaktiviert für Modulo großer Zahlen berechnen
By , 23. Juli 2015

Hallo,
bei einer Berechnung von Modulo-Werten, also dem ganzzahligen Rest einer Division, bin ich auf ein Problem gestoßen, dessen Lösung ich euch nicht vorenthalten möchte.
Angenommen ihr möchtet den Modulo-Wert einer sehr großen Zahl berechnen. Dann stößt Access schnell an die Grenze des Longinteger-Wertebereichs, der bekanntlich bis 2147483647 reicht.
Beispiel:
2147483647 Mod 97 Ergebnis 65
2147483648 Mod 97 Ergebnis Überlauf.

Erinnert man sich wie der Modulo-Wert (ganzzahliger Rest einer Division) berechnet wird:
2147483648 geteilt durch 97 ergibt 22139006,86
Multipliziert man 22139006 mit 97, und zieht das Ergebnis von 2147483648 ab, so erhält man als Modulo-Wert 66

Und genau so bauen wir eine kleine Hilfsfunktion auf, die uns den Modulo-Wert berechnet:

Public Function Modulo(ByVal Dividend As Double, ByVal Devisor As Double) As Long
    Dim GanzzahlErgebnis As Long
    If Devisor = 0 Then Exit Function
    
    GanzzahlErgebnis = Fix(Dividend / Devisor)
    Modulo = Dividend - GanzzahlErgebnis * Devisor
End Function

Der Wert von GanzzahlErgebnis muss wirklich die abgeschnittene ganze Zahl der Division sein, deswegen muss hier die Funktion fix() verwendet werden.
Da wir immer den ganzzahligen Rest als Ergebnis möchten, genügt es die Prozedur als Long zu deklarieren.

Kopiert die Funktion in ein Modul und ruft sie z.B. wie folgt auf:

MsgBox Modulo(2200000000, 97)

Als Antwort wird die Zahl 36 ausgegeben.

Bis dahin
© 2015 Andreas Vogt

Median ermitteln

comments Kommentare deaktiviert für Median ermitteln
By , 16. Juni 2015

Hallo,
heute möchte ich euch zeigen wie man aus Werten einer Tabelle oder Abfrage den Median bestimmt. Laut Wikipedia ist die Definition für den Median einer Auflistung der Wert, der an der mittleren Stelle steht, wenn man die Werte der Größe nach sortiert.
Beispiel: 9;14;20;30;50 Der mittlere Wert der sortierten Auflistung ist hier die 20, also ist 20 der Median. Hat man eine gerade Anzahl an Werten, so gibt es keinen mittleren Wert, also nimmt man die beiden mittleren Werte der sortierten Auflistung und bildet daraus den Mittelwert. Beispiel: 9;14;20;30 Der Median berechnet sich hier aus (14 + 20) / 2, also 17.
Bildet man diese Vorschriften auf VBA Code ab, so ist zu unterscheiden zwischer gerader Anzahl Datensätze und ungerader. Dies lässt sich feststellen indem man durch 2 teilt und den ganzzahligen Rest sich ansieht. Das macht dankenswerter Weise die interne Methode Mod (Mod für Modulo) für uns.
Beispiele:
0 Mod 2 = 0
1 Mod 2 = 1
40 Mod 2 = 0
99 Mod 2 = 1
… usw.
Also überall wo 0 heraus kommt haben wir eine gerade Anzahl von Datensätzen. Aufpassen müssen wir bei der 0, also keine Datensätze. Wenn wir dies nicht beachten laufen wir in eine Fehlermeldung hinein.
So genug der Theorie, kommen wir man zum Code.

Public Function Median(ByVal TableName As String, ByVal FieldName As String) As Double
    Dim numDS As Long
    Dim lowerValue As Double
    Dim upperValue As Double
    Dim rst As DAO.Recordset

    Set rst = CurrentDb.OpenRecordset("Select " & FieldName & " From " & TableName & " Order By " & FieldName, dbOpenSnapshot)
    If Not rst.EOF Then
        With rst
            .MoveLast
            numDS = .RecordCount
            .MoveFirst
            If numDS Mod 2 = 0 Then
                .Move Int(numDS / 2) - 1
                lowerValue = .Fields(FieldName)
                .MoveNext
                upperValue = .Fields(FieldName)
                Median = (lowerValue + upperValue) / 2
            Else
                .Move Int(numDS / 2)
                Median = .Fields(FieldName)
            End If
        End With
        
        rst.Close: Set rst = Nothing
    Else
        rst.Close: Set rst = Nothing
        Err.Raise vbObjectError + 100, "Function Median", "Empty Recordset"
    End If
End Function

Der Funktion werden 2 Parameter übergeben, einen für den Tabellennamen bzw. den Namen der Abfrage, und einen für das Feldnamen von dem der Median berechnet werden soll.
Die Daten stellen wir in einem Recordset-Objekt zur Verfügung, worin diese auch gleich aufsteigend sortiert werden. Um die korrekte Anzahl von Datensätzen zu erhalten, muss der Datensatzzeiger ans Ende gesetzt werden.
Danach kommt die Entscheidung ob ganzzahlig oder nicht. Mal angenommen wir haben 27 Messwerte in der Tabelle. dann benötigen wir den 14. Wert. Also müssen wir den Datensatzzeiger um 13 Stellen von der ersten Position verschieben. Daher Int(numDS / 2) – 1. Bei 26 Messwerten benötigen wir den 13. und 14. Wert für die Mittelwertbildung. Das sind die Variablen lowerValue und upperValue. Also Datensatzzeiger um 26/2 -1 = 12 Datensätze verschieben. Beim upperValue brauchen wir einfach um 1 weiter gehen, daher Methode .MoveNext. Zu Schluss noch die üblichen Aufräumarbeiten die ja bei Recordsets bekannt sein sollten.

So jetzt noch der Fall dass das Recordset keine Datensätze liefern würde. Dann wird die äußere If-Verzweigung den Code übersprungen und zum Else-Teil wird ausgeführt. Dort schließen wir erstmal ordentlich das Recordset-Objekt und setzen es Nothing um das Objekt zu zerstören. Danach geben wir eine Fehlermeldung an die aufrufende Prozedur weiter die diese entsprechend verarbeiten kann.

Das wars auch schon, aufrufen kann man die Funktion aus einem Formular, Bericht, Modul oder auch Abfrage heraus.

Bis dahin
© 2015 Andreas Vogt

Umgang mit Optionswerten

comments Kommentare deaktiviert für Umgang mit Optionswerten
By , 15. Mai 2015

Hallo,
heute befasse ich mich mit dem Thema „Umgang mit Optionswerten“. Es gibt kaum eine Anwendung die ohne Optionen auskommt. Sei es ein bestimmtes Verzeichnis oder bestimmte Werte oder Zustände.
Per Zufall bin ich heute auf eine Sache gestoßen in Verbindung mit Arrays: Ich wollte die in der gespeicherten Tabelle in ein Array laden um auf sie zugreifen zu können. Aber ein Element eines Arrays lässt sich nur über den Index abrufen, nicht über einen aussagekräftigen Namen.
Also hab ich mal herumgetüftelt, und schließlich doch eine sehr brauchbare Lösung gefunden.
Meine Tabelle hat 6 Optionsfelder. Ich erstelle also zuerst einen Öffentlichen Enum mit den Feldnamen:

Public Enum ltOption
    sportjahr = 0
    old_sportjahr = 1
    vereinsname = 2
    vereinsNummer = 3
    adminpassword = 4
    usestartgeld = 5
End Enum

Als nächstes benötigen wird 2 Variablen:

Public myOptions(5) As Variant
Private FieldNameArr As Variant

Zum Setzen der Optionswerte und zum Auslesen benötigen wird Get/Let Properties:

Public Property Get Settings(cOption As ltOption) As Variant
    Settings = myOptions(cOption)
End Property

Public Property Let Settings(cOption As ltOption, vValue As Variant)
    myOptions(cOption) = vValue
    CurrentDb.Execute "Update tabOptionen set " & FieldNameArr(cOption) & " = " & OptionDataType(vValue, cOption)
End Property

Read more »

Audit Trail – oder wie protokoliert man Datenänderungen

comments Kommentare deaktiviert für Audit Trail – oder wie protokoliert man Datenänderungen
By , 11. Mai 2015


Hallo,
das Thema heute handelt von der Protokollierung von Datensatzänderungen auf Formularbasis, der Fachbegriff dazu lautet Audit Trail. Datensatzänderungen in einer Abfrage oder direkt in einer Tabelle können in Access Jet nicht überwacht werden. Deshalb ist dem Anwender der Zugriff auf beide zu verwehren mit verschiedenen Techniken.

 
 

1. Definition und Motivation top

Laut Gabler Wirtschaftslexikon dient ein Audit Trail einerseits der „Prüfung bzw. Überwachung der Handelnden und ihrer Aktivitäten, anderseits kann dadurch im Schadensfall bzw. zwecks Aufdeckung doloser Handlungen die Handlungsfolge rückverfolgt und auch eine System- bzw. Datenwiederherstellung vereinfacht werden. So sind gezielte Prüf- und Korrekturmöglichkeiten von fehlerhaften bzw. inkriminierten Benutzereingaben möglich“

Für uns in der EDV heruntergebrochen dient ein Audit Trail zur Prüfung bzw. Überwachung von Dateneingaben, -Änderungen bzw. -Löschungen um z.b. im Fall eines Schadens die Datenintegrität wieder herzustellen oder auch bei juristischen Auseinandersetzungen Beweise für Fehleingaben (oder eben nicht) zu besitzen.

Die Motivation zur Durchführung des Audit Trails können sehr unterschiedlich sein. Z.B. zur Überwachung einzelner Arbeitsplätze wo gehäuft Fehleingaben im EDV-System vorgefallen sind, oder auch um Datenanalyse durchführen zu können, und nicht zuletzt auch zur Einhaltung der Datenintegrität.
Aber bei aller Liebe zur Technik, ein Audit Trail darf kein Selbstzweck sein, denn es bindet Ressourcen im Unternehmen und kostet somit reales Geld – eventuelle rechtliche Fragen jetzt mal ausgeschlossen.

In diesem Beitrag möchte ich aber nur auf die Technik dazu eingehen, denn das interessiert wohl die meisten Leser.
Fangen wir an beim Formular. Die zu überwachenden Steuerelemente sind im Wesentlichen TextBox, ComboBox, ListBox, CheckBox, Optionsfeld und Umschaltfläche. Um diese zu Überwachen müssen die Steuerelemente an eine Datenquelle, z.B. Abfrage oder Tabelle, gebunden sein.
 
 

2. Verwendete Formular-Ereignisse top

BeforeUpdate: Dieses Ereignis tritt ein, wenn nach einer Datenänderung der Datensatz gewechselt wird, oder wenn z.B. durch klicken der Focus in ein Unterformular gesetzt wird. Zur Datensatzänderung zählt hier neben der Änderung auch die Neuanlage. Beide unterscheidet man wie folgt:

Private Sub form_BeforeUpdate(Cancel As Integer)
    If Me.NewRecord Then
        MsgBox "NeuerDatensatz"
    Else
        MsgBox "Datensatzänderung"
    End If
End Sub

Delete: Dieses Ereignis tritt ein, wenn ein Datensatz gelöscht wurde. Dieses Ereignis verwenden wir um die Löschung zu protokollieren:

Private Sub form_Delete(Cancel As Integer)
    'Audit Trail Delete
End Sub

AfterDelConfirm: Dieses Ereignis tritt ein, wenn – bei aktivierter Option „Datensatzänderungen“ – ein Datensatz gelöscht wird und bei dem folgenden Bestätigungsdialog entweder der Löschung zugestimmt wird oder diese abgebrochen wird. Diese Option befindet sich unter Access-Optionen/Clienteinstellungen/Bestätigen. Das Event liefert einen Status, mithilfe man unterscheidet ob der Löschvorgang abgebrochen wurde:

Private Sub form_AfterDelConfirm(Status As Integer)
    If Status <> acDeleteOK Then MsgBox "Datensatz wurde gelöscht"
End Sub

Die Aktivierungsreihenfolge der Ereignisse ist: Delete, AfterDelConfirm.
Doch wozu benötigen wir AfterDelConfirm wenn im Ereignis Delete bereits das Löschen protokolliert wurde? Nun, es könnte sein, dass der Nutzer im Bestätigungsdialog das Löschen rückgängig macht, dann müssen wir dafür sorgen dass die Log-Datei bereinigt wird, denn es steht ja das Löschen bereits drin.

Das waren die Ereignisse (Events), welche wir für das Audit Trail benötigen. Was im wesentlichen noch fehlt ist eine Funktion die die Log schreibt, und eine Funktion die ggf. die Log bereinigt.
Jetzt gehen wir aber nicht hin und „müllen“ unsere Formularmodule mit redundantem Code zu, sondern machen das ganz elegant per Klassenmodul, wo wir auch die Events der Formulare abbilden werden.
Der interessierte Leser weiss ja, dass ich auf OOP abfahre und alles möglichst Objektorientiert programmiere.
 
 

3. Implementierung im Formular top

Zuerst benötigen wir eine Referenzierung auf die Klasse um davon ein Objekt ableiten zu können:

Dim myAudit As clsAuditTrail
Private Sub Form_Load()
    Set myAudit = New clsAuditTrail
    Set myAudit.FormObj = Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set myAudit = Nothing
End Sub

Es wird ein Objekt erstellt „myAudit“, und die Eigenschaft „FormObj“ mit dem Formular-Objekt des aktuellen Formulares belegt.
Verwenden Sie Unterformulare? Dann können Sie auch dort das Audit Trail einsetzen, indem sie das Formular öffnen und dort obigen Code hinein kopieren. Nicht vergessen die Marke für die zu überwachenden Datenfelder zu setzen. Wenn Sie allerdings innerhalb des Unterformular-Steuerelementes eine Abfrage oder Tabelle einsetzen, dann können Sie keine Änderungen protokollieren da weder Abfragen noch Tabellen Eventhandler besitzen.
 
 

4. Funktionsweise der Klasse top

Werfen wir mal einen kurzen Blick in die Klasse.
Um nun innerhalb der Klasse auf die oben genannten Formular-Ereignisse reagieren zu können, muss zuerst das Form-Object übernommen und in einer Variablen gespeichert werden, und danach die Eventhandler definiert werden:

Public Property Set FormObj(ByRef FRM_ As Access.Form)
    Set m_frm = FRM_
    m_IdFieldName = getIDField(FRM_)
    m_frm.BeforeUpdate = "[Event Procedure]"
    m_frm.OnDelete = "[Event Procedure]"
    m_frm.AfterDelConfirm = "[Event Procedure]"
End Property

In der Variable m_IdFieldName wird der Name des Formulars gespeichert, da dieser an späterer Stelle benötigt wird. Die Eventhandler werden auf einfachste Weise definiert, indem man dem möglichen Ereignis den Textstring „[Event Procedure]“ zuweist. Ohne diese Zuweisung werden keine Events gefeuert.
Die Programmierung der Formular-Ereignisse in der Klasse geschieht auf identische Weise wie im Formular, nur haben wir hier nicht das Form-Object sondern seinen Stellvertreter m_frm.
Ein Beispiel:

Private Sub m_frm_AfterDelConfirm(Status As Integer)
    If Status <> acDeleteOK Then Call DataRedoDelete
End Sub

Verwendet man innerhalb der Formulare ebenfalls die gleichen Eventhandler, so ist zu bedenken dass immer zuerst der Eventhandler des Formulars feuert, und dann erst der in der Klasse. Das kann funktionierten, kann aber auch zu problemen führen.

Kommen wir nun zum eigentlichen Protokollieren. Dieser Algorithmus ist eigentlich ziemlich einfach.
Man prüft alle Steuerelemente des Formulars in einer Schleife ob die Eigenschaft Value <> der Eigenschaft OldValue ist. Trift dies zu hat man eine Datensatzänderung. Da nur Steuerelemente die Eigenschaft Value haben, die auch einen Steuerelementinhalt besitzen, ist es ratsam einfach alle zu überwachenden Steuerelemente mit einer Marke auszustatten. Ich habe im Beispiel als Marke den Text Audit verwendet.

Da man nicht nur die Änderung sondern auch Wer Wann und Wo geändert hat, benötigen wir dazu noch ein paar Werte. Die Vaiable lngInsertedID wird benötigt, um beim Löschen die ID des eingefügten Datensatzes in der Log zu behalten. Wird das Löschen nämlich abgebrochen werden wir anhand dieser Variable den zu entfernenden Datensatz aus der Log identifizieren.

Private Sub DataChanges()
    Dim CTL As Control
    Dim lngInsertedID As Long

    dtmCurrentDateTime = Now()
    strUserName = Environ("USERNAME")
    Select Case UserAction
    Case "EDIT"
        For Each CTL In m_frm.Controls
            If CTL.Tag = "Audit" Then
                If Nz(CTL.Value) <> Nz(CTL.OldValue) Then
                    WriteEditLog CTL
                End If
            End If
        Next CTL
    Case Else
        lngInsertedID = WriteNewDeleteLog
        If UserAction = "DELETE" Then lastIdentifier = lngInsertedID
    End Select
End Sub

Die Prozedur WriteEditLog übernimmt das Steuerelement-Objekt CTL, welches sich geändert hat. Aus diesem Objekt erhalten wir die Werte für Value, OldValue und ControlSource, also der Name des Tabellenfeldes das an dieses Control gebunden ist:

Private Sub WriteEditLog(ByRef CTL_ As Access.Control)
    Dim strSQL As String
    strSQL = "Insert into tblAuditTrailLog (AuditTime, UserName, FormName, FieldName, ActionType, RecordID, OldValue, NewValue) Values (" & _
             "'" & dtmCurrentDateTime & "', " & _
             "'" & strUserName & "', " & _
             "'" & m_frm.Name & "', " & _
             "'" & CTL_.ControlSource & "', " & _
             "'" & UserAction & "', " & _
             "'" & m_frm.Controls(m_IdFieldName).Value & "', " & _
             "'" & CTL_.OldValue & "', " & _
             "'" & CTL_.Value & "' " & _
             ")"
    CurrentProject.Connection.Execute strSQL
End Sub

Bei der Löschung / Neuanlage ist es ähnlich, nur benötigen wir dort die Felder AuditTime, UserName, FormName, ActionType, RecordID. Was zum Schluss noch fehlt sind ein paar Properties, Hilfsfunktionen und Variablendeklarationen.

 
 

5. Setup und Initialisierung top

Was noch fehlt ist ein Setup, welches beim erstmaligen Verwenden der Klasse die Log-Tabelle für das Audit Trail anlegt.
Um diese Tabellenerstellungs-Abfrage nur 1-mal auszuführen, muss geprüft werden ob die Tabelle bereits existiert. Dazu greifen wir per Dlookup() auf die System-Tabelle MSysObjects zu, in der alle angelegten Access-Objekte gespeichert werden. Ausgeführt wird das beim Klassen-Ereignis „Initialize“:

Private Sub Class_Initialize()
    Dim strSQL As String
    strSQL = "Create Table tblAuditTrailLog (" & _
             "ID COUNTER CONSTRAINT ID PRIMARY KEY, " & _
             "AuditTime date, " & _
             "UserName Text, " & _
             "FormName Text, " & _
             "FieldName Text, " & _
             "ActionType Text, " & _
             "RecordID Text, " & _
             "OldValue Text, " & _
             "NewValue Text" & _
             ")"
    If Not AuditTabExists Then
        CurrentProject.Connection.Execute strSQL
    End If
End Sub

In der Variable strSQL wird die Tabellenerstellungs-Abfrage zusammengestellt. Man beachte dass ein AutoWert-Feld als COUNTER CONSTRAINT definiert wird. Die Funktion AuditTabExists prüft in MSysObjects ob bereits ein Eintrag mit Namen „tblAuditTrailLog“ vorhanden ist, falls nicht wird die Tabelle erstellt.

 
 

6. Die Klasse clsAuditTrail top

Die fertige Klasse clsAuditTrail sieht nun so aus:

Option Explicit
Option Compare Text

' ================================================
' Code by Andreas Vogt Email: info@accessblog.de
' ================================================

Private WithEvents m_frm As Form

Private m_Identifier As Long
Private m_IdFieldName As String
Private m_UserAction As String
Private m_AuditTabExists As Boolean

Private dtmCurrentDateTime As Date
Private strUserName As String

Public Property Set FormObj(ByRef FRM_ As Access.Form)
    Set m_frm = FRM_
    m_IdFieldName = getIDField(FRM_)
    m_frm.BeforeUpdate = "[Event Procedure]"
    m_frm.AfterUpdate = "[Event Procedure]"
    m_frm.OnDelete = "[Event Procedure]"
    m_frm.AfterDelConfirm = "[Event Procedure]"
End Property

Private Property Get AuditTabExists() As Boolean
    If Not m_AuditTabExists Then
        m_AuditTabExists = IsNull(DLookup("[Name]", "MSysObjects", "[Name] = 'tblAuditTrailLog' AND (Type = 1 Or Type = 6)")) = False
    End If
    AuditTabExists = m_AuditTabExists
End Property

Private Property Get UserAction() As String
    UserAction = m_UserAction
End Property

Private Property Let UserAction(ByVal UserAction_ As String)
    m_UserAction = UserAction_
End Property

Private Property Get lastIdentifier() As Long
    lastIdentifier = m_Identifier
End Property

Private Property Let lastIdentifier(ByVal lastident As Long)
    m_Identifier = lastident
End Property

Private Sub Class_Initialize()
    Dim strSQL As String
    strSQL = "Create Table tblAuditTrailLog (" & _
             "ID COUNTER CONSTRAINT ID PRIMARY KEY, " & _
             "AuditTime date, " & _
             "UserName Text, " & _
             "FormName Text, " & _
             "FieldName Text, " & _
             "ActionType Text, " & _
             "RecordID Text, " & _
             "OldValue Text, " & _
             "NewValue Text" & _
             ")"
    If Not AuditTabExists Then
        CurrentProject.Connection.Execute strSQL
    End If
End Sub

Private Sub Class_Terminate()
    Set m_frm = Nothing
End Sub

Private Sub m_frm_Delete(Cancel As Integer)
    UserAction = "DELETE"
    DataChanges
End Sub

Private Sub m_frm_AfterDelConfirm(Status As Integer)
    If Status <> acDeleteOK Then Call DataRedoDelete
End Sub

Private Sub m_frm_BeforeUpdate(Cancel As Integer)
    If m_frm.NewRecord Then
        UserAction = "NEW"
        DataChanges
    Else
        UserAction = "EDIT"
        DataChanges
    End If
End Sub

Private Sub DataChanges()
    Dim CTL As Control
    Dim lngInsertedID As Long

    dtmCurrentDateTime = Now()
    strUserName = Environ("USERNAME")
    Select Case UserAction
    Case "EDIT"
        For Each CTL In m_frm.Controls
            If CTL.Tag = "Audit" Then
                If Nz(CTL.Value) <> Nz(CTL.OldValue) Then
                    WriteEditLog CTL
                End If
            End If
        Next CTL
    Case Else
        lngInsertedID = WriteNewDeleteLog
        If UserAction = "DELETE" Then lastIdentifier = lngInsertedID
    End Select
End Sub

Private Sub WriteEditLog(ByRef CTL_ As Access.Control)
    Dim strSQL As String
    strSQL = "Insert into tblAuditTrailLog (AuditTime, UserName, FormName, FieldName, ActionType, RecordID, OldValue, NewValue) Values (" & _
             "'" & dtmCurrentDateTime & "', " & _
             "'" & strUserName & "', " & _
             "'" & m_frm.Name & "', " & _
             "'" & CTL_.ControlSource & "', " & _
             "'" & UserAction & "', " & _
             "'" & m_frm.Controls(m_IdFieldName).Value & "', " & _
             "'" & CTL_.OldValue & "', " & _
             "'" & CTL_.Value & "' " & _
             ")"
    CurrentProject.Connection.Execute strSQL
    
End Sub

Private Function WriteNewDeleteLog() As Long
    Dim strSQL As String
    Dim RecordsAffected As Long
    Dim cnn As New ADODB.Connection
    Dim rstTemp As ADODB.Recordset

    strSQL = "Insert into tblAuditTrailLog (AuditTime, UserName, FormName, ActionType, RecordID) Values (" & _
             "'" & dtmCurrentDateTime & "', " & _
             "'" & strUserName & "', " & _
             "'" & m_frm.Name & "', " & _
             "'" & UserAction & "', " & _
             "'" & m_frm.Recordset.Fields(m_IdFieldName).Value & "')"
    Set cnn = CurrentProject.Connection
    cnn.Execute strSQL, RecordsAffected
    If RecordsAffected > 0 Then
        Set rstTemp = cnn.Execute("SELECT @@IDENTITY")
        WriteNewDeleteLog = rstTemp(0)
        rstTemp.Close
    End If

    Set rstTemp = Nothing
    Set cnn = Nothing
End Function

Private Sub DataRedoDelete()
    Dim rstTemp As ADODB.Recordset

    Set rstTemp = New ADODB.Recordset
    With rstTemp
        .Open "SELECT * FROM tblAuditTrailLog", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
        .Find "ID = " & lastIdentifier
        If Not .EOF Then
            .Delete
        End If
    End With

    rstTemp.Close
    Set rstTemp = Nothing
End Sub

Private Function getIDField(FRM_ As Access.Form) As String
    Dim i As Long
    With FRM_.Recordset
        For i = 0 To .Fields.Count - 1
            If .Fields(i).Type = 4 Then
                getIDField = .Fields(i).Name
                Exit For
            End If
        Next i
    End With
End Function

Bis dahin
© 2015 Andreas Vogt

Zippen und Unzippen aus Access heraus Teil 1

By , 6. März 2014

Erstellt man z.B. aus Access heraus PDF-Dateien – so wie im vorigen Artikel gezeigt – dann möchte man diese unter Umständen auch per Email verschicken, z.B. einen regelmäßigen Umsatzbericht an die Geschäftsleitung. Da würde es Sinn machen, vorher die PDF-Dateien in einem Zip-Archiv zusammenzufügen.
Ein anderes Szenario wäre, Sie erhalten regelmäßig Textdateien in gezippter Form, und möchten diese in eine Access-Tabelle importieren.
Die Möglichkeiten die man dazu hat sind überschaubar. Man könnte z.B. Winzip oder Winrar automatisieren. Was aber wenn es nicht gestattet ist 3th Party Software auf dem Rechner zu installieren, und weder Winzip noch Winrar sind verfügbar.

Für so einen Fall gibt es verschiedene DLL-Bibliotheken von externen Anbietern, die die Zip/Unzip Funktionaliät bieten. Und so eine möchte ich heute vorstellen, nämlich „SawZipNG“. Leider ist dieses geniale Projekt eingestellt worden, und der Entwickler auch nicht mehr erreichbar. Zum Glück hat sich noch eine Kopie der DLL und der Dokumentation auftreiben lassen, die ich im Downloadbereich zur Verfügung stellen werde.

Laden Sie sich die DLL aus dem Downloadbereich herunter, und führen Sie die Anwendung aus. Die DLL-Datei wird automatisch registriert.

Danach steht Ihnen die die Zip/Unzip Funktionalität zur Verfügung. Öffnen Sie Ihre Access Anwendung und den VBA-Editor, und wählen Sie unter Extra/Verweise den Eintrag SAWZIPNG aus. Im Folgenden Beispiel zeige ich Ihnen wie Sie z.B. eine zuvor erstellte PDF-Datei zippen bzw. ein Archiv unzippen können. Sehen Sie sich dazu auch die Dokumentation an (Downloadbereich).
Beispiel 1: Eine einzelne Datei Zippen

Public Sub CreateZIPSingle(ByVal cSourceFileName AS String, _
                           ByVal cZipFileName AS String, _
                           Optional ByVal bFullpath As Boolean = False, _
                           Optional ByVal cComment As String = "", _
                           Optional ByVal cPassword AS String = "")

    Dim objZipArchive As SAWZipNG.Archive
    Set objZipArchive = New SAWZipNG.Archive

    With objZipArchive 
        .Create cZipFileName
        .Password = cPassword
        .AddFile cSourceFileName, bFullpath
        .Comment = cComment 
        .Close
    End With
    
    Set objZipArchive = Nothing
End Sub

Read more »

Bericht mit Filterkriterien nach PDF

By , 5. März 2014

Bis einschließlich der Version Access 2003 gab es keine eingebaute Funktion um einen Bericht nach PDF zu speichern. Zum Glück für diejenigen, die noch mit Access 2003 oder älter arbeiten, hat Stephen Lebans dafür eine DLL erstellt, mit der ab Access 2000 bis 2003 Berichte nach PDF gespeicherte werden können.
Hier gehts zum Link: http://www.lebans.com/reporttopdf.htm

Unter Access 2007 und neuer gibt es jetzt eine Möglichkeit, direkt einen Bericht nach PDF zu speichern: Docmd.OutputTo… mit dem AusgabeFilter acFormatPDF.
Will man aber dem Bericht Filterkriterien mitgeben, um z.B. nach einem bestimmten Kunden zu filtern, dann muss man schon ein bisschen mehr coden. Ich hab dazu mal ein Beispiel gemacht:

Private Sub ReportToPDF(ByVal cReportName As String, _
                        ByVal cReportFilter As String, _
                        ByVal cPDFName As String, _
                        Optional ByVal cHeadline As String = "Umsatzbericht")
    
    DoCmd.OpenReport cReportName, acPreview, , cReportFilter, acHidden
    Reports(cReportName).Titelzeile.Caption = cHeadline
    DoCmd.OutputTo acOutputReport, cReportName, acFormatPDF, cPDFName, False
    DoCmd.Close acReport, cReportName, acSaveNo
End Sub

Read more »

OfficeFolders theme by Themocracy