Here is what the code looks like :
This is the class clsAudit
Code:
Private WithEvents m_cboComboBox As ComboBox
Private WithEvents m_txtTextBox As TextBox
Private m_Control As Access.Control
Private m_ExternalDBPath As String
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Property Let TextControl(NameofTextControl As Variant)
Set m_txtTextBox = NameofTextControl
m_txtTextBox.AfterUpdate = "[Event Procedure]"
Set m_Control = m_txtTextBox
End Property
Public Property Let ComboControl(NameofComboControl As Variant)
Set m_cboComboBox = NameofComboControl
m_cboComboBox.AfterUpdate = "[Event Procedure]"
Set m_Control = m_cboComboBox
End Property
Private Sub m_txtTextBox_AfterUpdate()
Call LogAudit
End Sub
Private Sub m_cboComboBox_AfterUpdate()
Call LogAudit
End Sub
Public Property Let SaveInDatabase(FullExtDBPath As String)
m_ExternalDBPath = FullExtDBPath
End Property
Public Property Get SaveInDatabase() As String
SaveInDatabase = m_ExternalDBPath
End Property
Private Sub LogAudit()
Dim strSQL As String
Dim varPreviousValue As Variant
Dim varNewValue As Variant
Dim strFldName As String
Dim strRecordSource As String
Dim strFormUsedforUpdate As String
varPreviousValue = m_Control.OldValue
varNewValue = m_Control.Value
strFldName = m_Control.ControlSource
strFormUsedforUpdate = m_Control.Parent.Name ' Screen.ActiveForm.Name
strRecordSource = m_Control.Parent.RecordSource 'Forms(Screen.ActiveForm.Name).RecordSource
'
If varPreviousValue <> varNewValue Then 'if they replaced a value with the same value then their is not need to update.
If Len(varPreviousValue & "") <> 0 Then ' only capture a change when the control has previous data
strSQL = "INSERT INTO Usys_AuditTable (FormUsedtoChangeData, TheRecordSource, FieldName,PreviousValue,NewValue,TimeChanged,ChangedBy) " & _
"VALUES ('" & strFormUsedforUpdate & "',' " & strRecordSource & "','" & strFldName & "', '" & varPreviousValue & "', '" & varNewValue & "', '" & Now() & "' ,'" & fOSUserName & "')"
CurrentProject.Connection.Execute strSQL
End If
End If
End Sub
Private Sub Class_Terminate()
'Clean up pointers to controls
Set m_txtTextBox = Nothing
Set m_cboComboBox = Nothing
End Sub
Private Function fOSUserName() As String
'This function below was the only function that was not written by Dane Miller. It was written by Dev Ashish .
'******************** Code Start **************************
' This code was originally written by Dev Ashish. It is not to be altered or distributed,' except as part of an application.
' You are free to use it in any application, provided the copyright notice is left unchanged.'
' Code Courtesy of
' Dev Ashish
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function
class clsAuditCollection
Code:
Private m_ChangesCollection As Collection
Private m_ExternalDBPath As String
Public Function AddCombobox(myComboBox As Variant) As clsAudit
' 'Add a new control (textbox) item to the collection
Dim NewItem As New clsAudit
On Error GoTo ErrHandler
NewItem.ComboControl = myComboBox 'their is not need for a key to be added.
m_ChangesCollection.Add NewItem 'add to the private collection
Set AddCombobox = NewItem
Exit_Function:
Set NewItem = Nothing
Exit Function
ErrHandler:
If Err.Number = 13 Then
Resume Next
Else
MsgBox Err.Number & " " & Err.Description
Resume Exit_Function
End If
End Function
Public Function AddTextbox(myTextBox As Variant) As clsAudit
' Add a new control (combobox) item to the collection
Dim NewItem As New clsAudit
On Error GoTo ErrHandler
NewItem.TextControl = myTextBox 'their is not need for a key to be added.
m_ChangesCollection.Add NewItem 'add to the private collection
Set AddTextbox = NewItem
Exit_Function:
Set NewItem = Nothing
Exit Function
ErrHandler:
If Err.Number = 13 Then
Resume Next
Else
MsgBox Err.Number & " " & Err.Description
Resume Exit_Function
End If
End Function
Public Property Get SaveAuditChangesInDatabase() As String
SaveAuditChangesInDatabase = m_ExternalDBPath
End Property
Public Property Let SaveAuditChangesInDatabase(FullExtDBPath As String)
m_ExternalDBPath = FullExtDBPath
End Property
Private Sub Class_Initialize()
Set m_ChangesCollection = New Collection
End Sub
Private Sub Class_Terminate()
Set m_ChangesCollection = Nothing
End Sub
This is how it is called on the form
Code:
'Dim auditing As clsAuditCollection ' do your declaration at the module level
Dim Auditing As clsAuditCollection
Private Sub Form_Close()
Set Auditing = Nothing ' clean up
End Sub
Private Sub Form_Current()
Set Auditing = New clsAuditCollection ' initialize the class
With Auditing
.AddTextbox Me.Lastname ' me.lastname are controls on the form itself
.AddTextbox Me.FirstName
.AddTextbox Me.Salary
.AddCombobox Me.LeaveAmount
'.SaveAuditChangesInDatabase = "c:\Audit.mdb" ' here is where i am getting trouble to pass the value to the class clsAudit
End With
End Sub
I appreciate any help i can get.
Reply With Quote
