April 18, 2021, 02:26:03

Neuigkeiten:

Ist euer Problem gelöst, dann bitte den Knopf "Thema gelöst" drücken!


Datensatz löschen - Verhindern, dass nächste DS angezeigt wird

Begonnen von Nic-O, Mai 04, 2015, 11:36:44

⏪ vorheriges - nächstes ⏩

Nic-O

@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 ;-)

Hondo

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

Nic-O

@Andreas

sehr gerne. Ich habe ein wenig Erfahrung mit Java. Von daher scheue ich auch vor VBA nicht zurück.


MaggieMay

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... :-)
Freundliche Grüße
MaggieMay

Hondo

Mai 09, 2015, 09:30:45 #49 Letzte Bearbeitung: Mai 09, 2015, 18:35:34 von Hondo
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

voyager

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

voyager

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