Guten Tag zusammen,
nachdem mir bei meinem anderen Problem so schnell geholfen wurde, versuche ich es doch gleich noch einmal.
Meine DB läuft mit Audit Trail (Tool zum Änderungstracking).
Problem 1:
Wenn ich einen Datensatz lösche, dann springt er beim Löschen zum nächsten Datensatz, während der Hauptname des Datensatzes immer noch in einem DropDown-Feld vorhanden ist. Das ist für die Anwender sehr irritierend.
Problem 2:
Der Datensatz wird zwar gelöscht, aber in der Audit Trail Tabelle nimmt er den Namen des nächsten Datensatzes und nicht den eigentlich gelöschten.
Meine Theorie:
Wenn ich das 1. Problem behebe, erübrigt sich das 2. Vielleicht
Gruß,
Nico
Hallo,
1) Da dürfte ein Requery des Kombifeldes helfen...
2) Da dürfte es sich um ein Logikproblem in der Audittrail-Programmierung handeln...
Hallo Franz,
wie soll der Requery gesetzt werden? Nach dem Update oder?
Bsp.:
Private Sub mForm_AfterUpdate()
RequeryComboBox
End Sub
gruß,
Nico
Hi,
eher so:Private Sub Form_AfterUpdate()
Me!ComboBox.Requery
End Sub
Punkt 2 hat aber vermutlich nichts damit zu tun. Wann und wie wird das Audit-Trail geschrieben?
Hallo,
ich geh auch davon aus dass Auditrail zu spät geschrieben wird, nämlich wenn der DS bereits gelöscht ist.
Du musst dafür sorgen dass das Löschen bestätigt werden muss über Optionen/Client-Einstellungen/Bestätigen->Datensatzänderungen.
Dann kannst du Audittrail wie folgt aufrufen:
Private Sub Form_AfterDelConfirm(Status As Integer)
If Status = acDeleteOK Then Call AuditChanges("DatensatzID", "DELETE")
End Sub
Nachzulesen hier ganz unten:
http://www.fontstuff.com/access/acctut21.htm (http://www.fontstuff.com/access/acctut21.htm)
edit/
Mit DatensatzID ist gemeint der Feldname des DatensatzID des gebundenen Formulars.
Gruß Andreas
BTW: welches Audit-Trail verwendest du eigentlich?
Andreas
Ich weiß leider nicht welche Version das ist, da mein Vorgänger Praktikant dies ins Leben gerufen hat....
Anbei mal der Code des verwendeten Audit-Trail. Hat mir schon genug Probleme bereitet!! Habe nämlich versucht, diese Version und eine andere für Unterformulare zu nutzen. Hat leider nicht funktioniert...
Option Compare Database
Sub AuditChanges(IDField As String, UserAction As String)
On Error GoTo AuditChanges_Err
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim ctl As Control
Dim datTimeCheck As Date
Dim strUserID As String
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
strUserID = Environ("USERNAME")
Select Case UserAction
Case "EDIT"
For Each ctl In Screen.ActiveForm.Controls
If ctl.Tag = "Audit" Then
If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![Action] = UserAction
![RecordID] = Screen.ActiveForm.Controls(IDField).Value
![FieldName] = ctl.ControlSource
![OldValue] = ctl.OldValue
![NewValue] = ctl.Value
.Update
End With
End If
End If
Next ctl
Case Else
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![Action] = UserAction
![RecordID] = Screen.ActiveForm.Controls(IDField).Value
.Update
End With
End Select
AuditChanges_Exit:
On Error Resume Next
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Exit Sub
AuditChanges_Err:
MsgBox Err.Description, vbCritical, "ERROR!"
Resume AuditChanges_Exit
End Sub
Hi,
der Code ist für Unterformulare nicht geeignet, dazu brauchst du im einfachsten Fall eine separate Prozedur mit entsprechenden Anpassungen, bspw. der Übergabe des Namens vom Unterformularsteuerelement.
Was das Lösch-Protokoll betrifft, so solltest du noch zeigen wo und wie das Audit-Trail aufgerufen wird.
Guten Morgen,
hier der Code aus einem der Formulare:
'Änderungstracking LÖSCHEN
Private Sub Form_AfterDelConfirm(Status As Integer)
If Status = acDeleteOK Then Call AuditChanges("Kunden_Name", "DELETE")
End Sub
gruß,
Nico
Ja das ist schon korrekt, funktioniert aber nicht im Unterformular.
Gruß Andreas
Ich habe meine Oberfläche so umgebaut, dass es keine Unterformulare mehr gibt.
Somit gibt es nur noch die 2 oben genannten Probleme :-)
Hi,
ZitatIch habe meine Oberfläche so umgebaut, dass es keine Unterformulare mehr gibt.
das halte ich für die falsche Entscheidung, besser wäre es, die Prozedur zur Änderungsverfolgung anzupassen bzw. zu erweitern.
Und was das Protokollieren der Löschung betrifft, so ist "Form_AfterDelConfirm" offensichtlich das falsche Ereignis, weil da die Löschung bereits vollständig vollzogen ist.
Ich habe mich mehr als eine Woche mit der Änderung des Codes der Änderungsverfolgung beschäftigt und ware es zum Schluss einfach leid. Von daher bereue ich es bis dato kein Stück :-)
Ich bin bis zu dem Punkt gekommen, dass er Änderungen gespeichert hat. Neue oder gelöscht Einträge konnten jedoch nicht oder nur falsch getrackt werden.
@MaggieMay:
was würdest du denn anstatt "Form_AfterDelConfirm" verwenden? In der offiziellen Doku zu dem Modul wird ebenfalls von dieser Art gesprochen.
Hallo,
das Ereignis ist das richtige.
Zum Zeitpunkt wo der Bestätigungsdialog kommt ist die Änderung noch nicht gespeichert da dieser Dialog quasi Modal wirkt.
Ich hab diesen Audit-Trail als Klasse umgebaut, an der Unterformularfähigkeit bin ich noch am arbeiten. Das Funktioniert so dass die Controls des Hauptformulars durchlaufen werden bis ein UnterformularControl gefunden ist, dann wird der Prozess neu angestoßen mit dem SourceObject des Ufos und des IDFeldes welches z.B. als Tag gespeichert werden kann.
Sobald ich fertig bin veröffentliche ich es hier.
Gruß Andreas
Hallo,
Tipp: Form-Ereignis "Beim Löschen" benutzen"
Währenddessen sind die zu löschenden Daten noch verfügbar..
Neue Daten:
Im BeforeUpdate-Ereignis auf neuen DS testen:
If Me.Newrecord Then
'Daten mit Kennung "Neuer DS" wegschreiben
Else
'Daten "normal" wegschreiben
End If
PS: das AfterDeleteConfirm-Ereignis tritt nur auf, wenn in den Optionen/Clienteinstellungen/Bearbeiten Löschbestätigung angehakt ist.
Hi,
Zitatdas Ereignis ist das richtige.
ein Test hat ergeben, dass auf den Datensatz im Ereignis AfterDelConfirm nicht mehr zugegriffen werden kann, weil er bereits weg ist.
Wenn man das Delete-Ereignis nimmt und die Löschbestätigung anfordert, diese aber verweigert wird, so wird ein Löschvorgang protokolliert der keiner ist.
Man muss also vor dem Löschen das Protokoll schreiben und nach dem Löschen bestätigen, andernfalls wieder entfernen?
Ohne Löschbestätigung kann das also nicht gehen, oder?
ich habe jetzt folgendes ausprobiert:
'Private Sub Form_AfterDelConfirm(Status As Integer)
If Status = acDeleteOK Then Call AuditChanges("Kunden_Name", "DELETE")
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
If Me.NewRecord Then
'Daten mit Kennung "Neuer DS" wegschreiben
Else
'Daten "normal" wegschreiben
End If
End Sub
hat leider nicht funktioniert.
Ich hab aber mal den DS in einem anderen Formular offen gelassen. Dorst steht dann schön sauber in jedem Feld #gelöscht.
Schade, dass das nicht in dem Formular steht, in dem gelöscht wird...
(http://www.fotos-hochladen.net/uploads/gelschtznvaux0mpe.jpg) (http://www.fotos-hochladen.net)
Hallo,
ja stimmt, bei AfterDeleteConfirm ist der DS physisch bereits gelöscht.
Aber das Form hat sich noch nicht aktualisiert, sonst könnte in:
Screen.ActiveForm.Controls(m_IDField).Value nicht der korrekte (gelöschte) ID stehen.
Aber zu deinem Formular, da dürfte nicht #gelöscht stehen, das ist das Problem. Ist die Datenbank aufgeteilt, benutzt du ein Serverbackend?
Ich zitiere dazu mal Josef P.:
Zitat#Gelöscht wird normalerweise angezeigt, wenn ein Feld als Primärschlüssel verwendet wird, bei dem Access keine eindeutige Zuordnungen zu den Datensätzen machen kann.
Das könnten einerseits doppelte Werte im Primärschlüssel sein - es kann aber auch Probleme mit den Datentypen geben.
Oder es wurde kein Pirmärschlüssel in der verknüpften Tabelle eingestellt und die Datensatzzuordnung über alle Felder versagt, weil z. B. Float oder andere Zahlentypen nicht gut genug konvertiert werden konnten.
Falls du einen SQL Server als Backend hast, dann in jede Tabelle Current_Timestamp einfügen.
Andreas
Hi,
"hat nicht funktioniert" heißt was genau? Bezieht sich die Äußerung auf das Lösch-Protokoll oder auf die Update-Prozedur?
ZitatSchade...
Wieso, was hättest du davon?
Zitatsonst könnte in:
Screen.ActiveForm.Controls(m_IDField).Value nicht der korrekte (gelöschte) ID stehen.
Tut's ja auch gar nicht - zumindest nicht bei meinem Test.
also ich habe getestet mit Win7 Access 2010 2007er-DBFormat kein Backend, und da funktioniert es. Ich poste mal meine Klasse clsAuditTrail:
Option Explicit
Private WithEvents m_frm As Form
Private WithEvents m_CMDquit As CommandButton
Friend Sub Init(FRM As Form)
Set m_frm = FRM
Set m_CMDquit = m_frm.cmdQuit
m_frm.AfterDelConfirm = "[Event Procedure]"
m_frm.BeforeUpdate = "[Event Procedure]"
m_frm.OnClose = "[Event Procedure]"
m_CMDquit.OnClick = "[Event Procedure]"
m_frm.Visible = True
End Sub
Private Sub m_frm_Close()
Set m_CMDquit = Nothing
Set m_frm = Nothing
End Sub
Private Sub m_CMDquit_Click()
DoCmd.Quit
End Sub
Private Sub m_frm_AfterDelConfirm(Status As Integer)
If Status = acDeleteOK Then Call AuditChanges("DELETE")
End Sub
Private Sub m_frm_BeforeUpdate(Cancel As Integer)
If m_frm.NewRecord Then
Call AuditChanges("NEW")
Else
Call AuditChanges("EDIT")
End If
End Sub
Private Sub m_frmUfo_AfterDelConfirm(Status As Integer)
If Status = acDeleteOK Then Call AuditChanges("DELETE")
End Sub
Private Sub m_frmUfo_BeforeUpdate(Cancel As Integer)
If m_frm.NewRecord Then
Call AuditChanges("NEW")
Else
Call AuditChanges("EDIT")
End If
End Sub
Private Sub AuditChanges(UserAction As String)
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim CTL As Control
Dim datTimeCheck As Date
Dim strUserID As String
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
strUserID = Environ("USERNAME")
Select Case UserAction
Case "EDIT"
For Each CTL In Screen.ActiveForm.Controls
If CTL.Tag = "Audit" Then
If Nz(CTL.Value) <> Nz(CTL.OldValue) Then
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![action] = UserAction
![RecordID] = Screen.ActiveForm.Controls(getIDField).Value
![FieldName] = CTL.ControlSource
![OldValue] = CTL.OldValue
![NewValue] = CTL.Value
.Update
End With
End If
End If
Next CTL
Case Else
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![action] = UserAction
![RecordID] = Screen.ActiveForm.Controls(getIDField).Value
.Update
End With
End Select
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub
Private Function getIDField() As String
Dim i As Long
With Screen.ActiveForm.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
Im Startformular (im Beispiel frmHome) folgender Code:
Option Compare Database
Option Explicit
Private myAudit As clsAuditTrail
Private m_WrapColl As New Collection
Private Sub Form_Load()
Set myAudit = New clsAuditTrail
End Sub
Private Sub cmdAuditTrail_Click()
DoCmd.OpenTable "tblAuditTrail"
End Sub
Private Sub cmdCustomers_Click()
myAudit.Init Form_frmCustomers, "CustomerID"
m_WrapColl.Add myAudit
End Sub
Private Sub cmdEmployees_Click()
myAudit.Init Form_frmEmployees, "EmployeeID"
m_WrapColl.Add myAudit
End Sub
Private Sub cmdQuit_Click()
DoCmd.Quit
End Sub
Die Formulare frmCustomers und frmEmployees sind Codefrei, die Eigenschaft "Enthält Modul" muss aber auf ja stehen.
Gruß Andreas
Zitat von: Hondo am Mai 06, 2015, 16:32:08
Ist die Datenbank aufgeteilt, benutzt du ein Serverbackend?
Nein. Ich werde ledeglich die Tage die DB in 2 Teile splitten. Tabellen = Backend und der Rest alles ins Frontend. Einen Server wird es jedoch nicht geben.
Ich werde dein Codebeispiel erst morgen ausprobieren können. Vielen Dank schon mal dafür!
Hast du das Zitat oben gelesen? hast du die einzelne Punkte geprüft?
Andreas
Guten Morgen Zusammen,
Kann es daran liegen, dass Lieferantenprofil und Kundenprofil als Primärschlüssel aus Buchstaben besteht und alle anderen nummerisch sind?
hier mal ein Foto meiner Beziehungen.
(http://www.fotos-hochladen.net/uploads/beziehungen4pvai7cuzg.jpg) (http://www.fotos-hochladen.net)
Zitat"hat nicht funktioniert" heißt was genau? Bezieht sich die Äußerung auf das Lösch-Protokoll oder auf die Update-Prozedur?
Beides hat keine Veränderungen gebracht. Ich hatte den selben Fehler wie zuvor auch.
Zitat
sonst könnte in:
Screen.ActiveForm.Controls(m_IDField).Value nicht der korrekte (gelöschte) ID stehen.
wo finde ich das?
Ich hatte im 1. Semester mal ganz oberflächlich mit Access zu tun. Deshalb würde ich mich immer noch als absoluten Anfänger bezeichnen :D
Hi,
myAudit.Init Form_frmCustomers, "CustomerID"
was hast du mit dem zweiten Parameter vor? Die Init-Prozedur erwartet nur das Formular.
Die Tabellen Lieferantenprofil und Kundenprofil benötigen einen Identifier.
Was machst du wenn es 2 Firmen Maier gibt? Also, füge in beide Tabellen ein Autowert-Feld ein.
In den verknüpften Tabellen benennst du das Feld Lieferantenname in LieferantenID um, und verwendest als Datentyp LongInteger.
Ich denke mal dass due die Profile z.B. per Kombifeld auswählst, trage einfach sorge dass statt des Namens der ID-Wert in den Verbundenen Tabellen steht.
Dann wird sich das Problem erledigt haben.
Gruß Andreas
@MaggieMay:
in der Orginalen Version ist das richtig, ich habe das bei meiner Klasse anderst gelöst weil ich es unsinnig fand.
Andreas
@Hondo:
Dann passen also die von dir in Antwort #19 gezeigten Codes gar nicht zusammen?
Ich wollte das gern mal ausprobieren, was muss ich tun, damit es klappt?
Zitat von: Hondo am Mai 07, 2015, 12:40:16
Die Tabellen Lieferantenprofil und Kundenprofil benötigen einen Identifier.
Was machst du wenn es 2 Firmen Maier gibt? Also, füge in beide Tabellen ein Autowert-Feld ein.
In den verknüpften Tabellen benennst du das Feld Lieferantenname in LieferantenID um, und verwendest als Datentyp LongInteger.
Irgendwie stehe ich gerade auf dem Schlauch...
Also ich weiße den 2 Mastertabellen einen Autowert zu. Soll dieser auch zum Primärschlüssel werden?
Bsp.: LieferantenID
Oder kann das Feld XY genannt werden, hauptsache ein Autowert ist vorhanden?
Warum muss in den verknüpften Tabellen der Lieferantenname zu LieferantenID umbenannt werden? Den Wert LongInteger kann ich als Autowert und als Zahl zuweißen. Was soll ich nehmen?
Wiso Autowert? du hast doch gesagt die Primärschlüssel sind vom Datentyp Text??
Das ist der Fehler den du korrigieren musst.
Andreas
@MaggieMay: Hier ist das von mir überarbeitete Audittrail.
Gruß Andreas
Sind sie auch. Aber ich kann den Wert nicht nachträglich auf Autowert ändern.
Soll ich nun folgendes machen?
KundenID: Autowert (Primärschlüssel)
KundenName: Text (nicht mehr als Primärschlüssel)
Hallo,
ja..... und die Beziehungen anpassen....
EDIT: Jetzt geht gar nichts mehr... Datenstätze sind komplett verschwunden und es werden falsche Datensatzeinträge übergeben. Oder gar keine...
Zum Glück gibts ein Backup.
ok :D
ich kann mir richtig vorstellen, wie verzweifelt ihr vor euren Monitoren sitz und denkt: ohh mein gott... haha
Hallo,
ja logisch, in den Verbundenen Tabellen stehen ja keine ID-Werte sondern immer noch die Namen, wie soll das gehen?
Du hättest in den Master-Tabellen das Feld nicht umbenennen sollen sondern ein neues hinzufügen, das hab ich doch mehrfach geschrieben in diesem Thread.
Dann hätte man mit Aktionsabfragen die FremdSchlüssel setzen können.
Wieviele Datensätze hast du denn in den Verbundenen Tabellen so ca.?
Andreas
Hi Andreas,
ich habe ja in den beiden Mastertabellen ein neues Feld mit z.B. KundenID + Autowert erstellt und diesem den Primärschlüssel zugewiesen.
ca 60 - 80 Datensätze
Was Access angeht, bin ich wirklich ein Anfänger
gruß Nico
Wenn die Daten keiner Geheimhaltung unterliegen oder keine personenbezogene Daten sind, kannst du mir die Datenbank ja mal schicken, gezippt an "av punkt offenburg ät gmx.de". Ich sieh es mir gerne an und korrigiere es.
Andreas
@Hondo:
Es ist so wie ich es die ganze Zeit schon gesagt habe, das Protokollieren des gelöschten Datensatzes im AfterDelConfirm-Ereignis funktioniert nicht, weil der DS da schon weg ist. Daran ändert auch deine schöne neue Klasse nichts. ;-)
Also bei mir funktionierts??
hast du die Option eigentlich eingeschaltet dass DS Änderungen bestätigt werden müssen? Weil ohne das gehts nunmal nicht.
Ah vergaß, in den Formularen sind keine Felder für die CustomerID und EmployeeID, die müsste man als Textfelder in die beiden Forms einfügen, z.B. als unsichtbare felder.
Andreas
In dem Moment wo die Lösch-Nachfrage gestellt wird, ist der aktuelle Datensatz bereits aus dem Formular verschwunden. Was also soll da noch protokolliert werden können? Gehe ich auf Nein, ist der vorherige DS wie von Zauberhand wieder da. Aber wenn ich die Löschung bestätige, wird die falsche, also die nachfolgende DS-ID protokolliert.
Wieso merkt das denn eigentlich keiner?! ???
PS:
Wenn bei der Löschung eh nur die DS-ID protokolliert wird, so könnte man sich die ja im BeforeDelConfirm-Ereignis merken und im AfterDelConfirm irgendwie an das AuditTrail weiterreichen...
So ähnlich hatte ich das ja bereits schonmal vorgeschlagen. :-)
Hallo,
anbei eine Demonstration. In beiden Formularen habe ich kein IDFeld, es wird auf das RecordSource-Feld gezeigt.
http://www.accessblog.de/AuditTrail1.mp4 (http://www.accessblog.de/AuditTrail1.mp4)
Andreas
Oh je. Da Graut mir was.
Das Formular KundenprofilBearbeiten_F z.B., da ist ist das Kombinationsfeld Kombinationsfeld113 (was für ein besch... Name. Verwende doch eine durchgängige Benamsung wie z.B. comKunden oder cbKunden etc.)
Dieses Combo ist nicht gebunden obwohl beim Speichern das Feld benötigt wird. Gespeichert wird per Makro, ebenfalls ziemlich besch... .
Um deine Datenbank mit den dutzenden von Berichten, Abfragen, Formulare, Makros etc. zu Überarbeiten würde man sicherlich mehrere Arbeitstage benötigen. Frag doch mal den Franz ob er dafür Zeit und Nerven hat, kostenlos wird es aber nicht sein, aber auch nicht umsonst.
Gruß Andreas
Hier noch die Änderungsabfrage um den Fremdschlüssel zu befüllen:
UPDATE [Tabellennamen] AS L INNER JOIN [Profiltabelle] AS P ON P.Kunden_Name = L.Kunden_Name SET L.KUNDENID = P.KUNDENID;
für jede Tabelle musst du Tabellennamen und Profiltabelle einsetzen, und Kunden_Name und KUNDENID bei den Lieferanten anpassen.
Andreas
Hi,
Zitat von: Hondo am Mai 07, 2015, 18:08:19In beiden Formularen habe ich kein IDFeld, es wird auf das RecordSource-Feld gezeigt.
ich verstehe nicht ganz, was willst du damit sagen?
Das Video beweist, dass die falsche ID gespeichert wird (wenn man zusätzlich in die tblEmployees schaut).
Vergiss den Satz.
In der Tat wird der falsche DS geloggt, ist mir gar nicht aufgefallen.
Aber jetzt sehe ich die Intension warum der Entwickler dieses Event genommen hat. Schreibe ich das AuditTrail beim Ereignis "beim löschen", dann ist das AuditTrail bereits gelaufen wenn die Speicher-MSGBox kommt.
Was fehlt ist eine Methode AuditRedoChanges(), die falls man das Löschen abgebrochen hat den falschen Eintrag in der Log entfernt.
So, hier mal die aktuelle Klasse die auch beim Löschen den richtigen ID Loggt, bzw. bei Abbruch den Log entfernt:
Option Explicit
Private WithEvents m_frm As Form
Private WithEvents m_CMDquit As CommandButton
Private m_Identifier As Long
Private Property Get lastIdentifier() As Long
lastIdentifier = m_Identifier
End Property
Private Property Let lastIdentifier(ByVal lastident As Long)
m_Identifier = lastident
End Property
Friend Sub Init(FRM As Form)
Set m_frm = FRM
Set m_CMDquit = m_frm.cmdQuit
m_frm.AfterDelConfirm = "[Event Procedure]"
m_frm.BeforeUpdate = "[Event Procedure]"
m_frm.OnDelete = "[Event Procedure]"
m_frm.OnClose = "[Event Procedure]"
m_CMDquit.OnClick = "[Event Procedure]"
m_frm.Visible = True
End Sub
Private Sub m_frm_Close()
Set m_CMDquit = Nothing
Set m_frm = Nothing
End Sub
Private Sub m_CMDquit_Click()
DoCmd.Quit
End Sub
Private Sub m_frm_Delete(Cancel As Integer)
Call AuditChanges("DELETE")
End Sub
Private Sub m_frm_AfterDelConfirm(Status As Integer)
If Status <> acDeleteOK Then Call AuditRedoDelete
End Sub
Private Sub m_frm_BeforeUpdate(Cancel As Integer)
If m_frm.NewRecord Then
Call AuditChanges("NEW")
Else
Call AuditChanges("EDIT")
End If
End Sub
Private Sub AuditChanges(UserAction As String)
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim CTL As Control
Dim datTimeCheck As Date
Dim strUserID As String
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
strUserID = Environ("USERNAME")
Select Case UserAction
Case "EDIT"
For Each CTL In Screen.ActiveForm.Controls
If CTL.Tag = "Audit" Then
If Nz(CTL.Value) <> Nz(CTL.OldValue) Then
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![action] = UserAction
![RecordID] = Screen.ActiveForm.Controls(getIDField).Value
![FieldName] = CTL.ControlSource
![OldValue] = CTL.OldValue
![NewValue] = CTL.Value
.Update
End With
End If
End If
Next CTL
Case Else
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![action] = UserAction
![RecordID] = Screen.ActiveForm.Controls(getIDField).Value
.Update
If UserAction = "DELETE" Then lastIdentifier = ![AuditTrailID]
End With
End Select
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub
Private Sub AuditRedoDelete()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
rst.Find "AuditTrailID = " & lastIdentifier
If Not rst.EOF Then
rst.Delete
End If
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub
Private Function getIDField() As String
Dim i As Long
With Screen.ActiveForm.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
Der Code in frmHome (unverändert)
Option Explicit
' ================================================
' Code by Martin Green Email: martin@fontstuff.com
' Visit my Office Tips website @ www.fontstuff.com
' YouTube tutorials www.youtube.com/martingreenvba
' ================================================
Private myAudit As clsAuditTrail
Private m_WrapColl As New Collection
Private Sub Form_Load()
Set myAudit = New clsAuditTrail
End Sub
Private Sub cmdAuditTrail_Click()
DoCmd.OpenTable "tblAuditTrail"
End Sub
Private Sub cmdCustomers_Click()
myAudit.Init Form_frmCustomers
m_WrapColl.Add myAudit
End Sub
Private Sub cmdEmployees_Click()
myAudit.Init Form_frmEmployees
m_WrapColl.Add myAudit
End Sub
Private Sub cmdQuit_Click()
DoCmd.Quit
End Sub
Andreas
ZitatWas fehlt ist eine Methode AuditRedoChanges(), die falls man das Löschen abgebrochen hat den falschen Eintrag in der Log entfernt.
Genau das ist die Lösung, anders geht's nicht. Aber wie ist das denn in an anderer Stelle gelöst, ich meine dort wo die ursprüngliche Vorlage her kommt - wurde die Quelle hier eigentlich schon erwähnt?
@Andreas
die sah davor noch viel schlimmer aus. Das da überhaupt etwas funktioniert hat, hat mich schon gewundert.
Danke, dass du dir es trotzdem mal angeschaut hast! Ich werde versuchen, das Beste daraus zu machen ;-)
Hallo,
das Orginal stammt hiervon:
http://www.fontstuff.com/access/acctut21.htm
Nic-o, wenn du es selbst versuchen möchtest, dann mach ich dir die Tage mal ne Liste was wie umgesetzt werden sollte.
Du solltest dich aber wirklich mit VBA befassen, das ist einfacher als man denkt.
Andreas
@Andreas
sehr gerne. Ich habe ein wenig Erfahrung mit Java. Von daher scheue ich auch vor VBA nicht zurück.
Hi,
Zitat von: Hondo am Mai 08, 2015, 08:22:21das Orginal stammt hiervon:
dann stammt also auch von dort bereits der Fehler. Ich habe den Martin Green deswegen mal angeschrieben und auf die Sache (und unseren Thread) aufmerksam gemacht. Mal sehn, ob was zurück kommt... :-)
So, hier kommt die nochmals überarbeitete Klasse die uneingeschränkt Unterformular-fähig ist:
Als Download, ein kleiner Fehler war noch im Code.
Der Code in den Formularen die Überwacht werden sieht so aus:
Option Compare Database
Option Explicit
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
Die Formulare werden ganz normal über DoCmd.openForm "formName" geöffnet.
Alle Controls die Überwacht werden sollen, also nur die mit einem Steuerelementinhalt, haben den Tag (Marke): Audit
Gruß Andreas
Hallo zusammen,
das ist genau das, was ich suche. Ich habe den Code aus dem Download als "clsAuditTrail" angelegt, im Formular den Code hinterlegt und die Tabelle "tblAuditTrail" angelegt. Der Control Tag ist "Audit".
Im Test hat es erst nicht funktioniert, da ich das ADO nicht aktiviert hatte. Beim zweiten Test läuft alles ohne Fehler durch, in der Tabelle "tblAuditTrail" erscheint aber nichts. Ich nutze Access 2019.
Woran kann es liegen?
Option Explicit
Private WithEvents m_frm As Form
Private m_Identifier As Long
Private m_IdFieldName As String
Private cnn As ADODB.Connection
Private rst As ADODB.Recordset
Private datTimeCheck As Date
Private strUserID 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 lastIdentifier() As Long
lastIdentifier = m_Identifier
End Property
Private Property Let lastIdentifier(ByVal lastident As Long)
m_Identifier = lastident
End Property
Private Sub Class_Terminate()
Set m_frm = Nothing
End Sub
Private Sub m_frm_Delete(Cancel As Integer)
Call AuditChanges("DELETE")
End Sub
Private Sub m_frm_AfterDelConfirm(Status As Integer)
If Status <> acDeleteOK Then Call AuditRedoDelete
End Sub
Private Sub m_frm_BeforeUpdate(Cancel As Integer)
If m_frm.NewRecord Then
Call AuditChanges("NEW")
Else
Call AuditChanges("EDIT")
End If
End Sub
Private Sub AuditChanges(UserAction As String)
Dim CTL As Control
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
strUserID = CUser()
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
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = m_frm.Name
![Action] = UserAction
![RecordID] = m_frm.Controls(m_IdFieldName).Value
![FieldName] = CTL.ControlSource
![OldValue] = CTL.OldValue
![newValue] = CTL.Value
.Update
End With
End If
End If
Next CTL
Case Else
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = m_frm.Name
![Action] = UserAction
![RecordID] = m_frm.Recordset.Fields(m_IdFieldName).Value
.Update
If UserAction = "DELETE" Then lastIdentifier = ![AuditTrailID]
End With
End Select
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub
Private Sub AuditRedoDelete()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
rst.Find "AuditTrailID = " & lastIdentifier
If Not rst.EOF Then
rst.Delete
End If
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = 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
Im Formular:
Private Sub Form_Load()
Dim myAudit As clsAuditTrail
Set myAudit = New clsAuditTrail
Set myAudit.FormObj = Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim myAudit As clsAuditTrail
Set myAudit = Nothing
End Sub
So hat´s funktioniert, mit dem Zusatz des Tabellennamens, der mitgeschrieben wird:
Option Explicit
Option Compare Text
Private WithEvents m_frm As Form
Private m_Identifier As Long
Private m_IdFieldName As String
Private m_UserAction As String
Private datTimeCheck 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 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_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
datTimeCheck = 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, TableName, FieldName, ActionType, RecordID, OldValue, NewValue) Values (" & _
"'" & datTimeCheck & "', " & _
"'" & strUserName & "', " & _
"'" & m_frm.Name & "', " & _
"'" & m_frm.RecordSource & "', " & _
"'" & 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
Dim CTL As Control
strSQL = "Insert into tblAuditTrailLog (AuditTime, UserName, FormName, ActionType, RecordID) Values (" & _
"'" & datTimeCheck & "', " & _
"'" & 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
und im Formular:
Option Compare Database
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