Event Logger Module Need some help to add a small part (1 Viewer)

StanJx

Registered User.
Local time
Today, 17:27
Joined
Apr 5, 2012
Messages
21
Hi All,

I am new to this forum. I am not familiar with modules. But I needed a event logger for my database and I found a solution via module. I have tested the current code and it works perfectly except for a small blip. I have a field called UserName in the same table which needs to be populated from

Code:
Forms!frmLogin!cmbUserName
my login form which hides after the user logs in. I can't figure out how to write the code so this data enters into the table. Here is the code I have at the moment:

Code:
Option Compare Database
Option Explicit

'Purpose:       Log when your forms/reports are opened/closed.
'Usage:         Open/close events of forms/reports call LogDocOpen() and LogDocClose()

'Set this to False to turn all logging off.
Private Const mbLogDox As Boolean = True
'Name of this module (for error logger.)
Private Const conMod = "ajbLogDoc"

'API calls to get the Windows user name and computer name
Private Declare PtrSafe Function apiGetUserName Lib "advapi32.dll" _
    Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare PtrSafe Function apiGetComputerName Lib "kernel32" _
    Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    
Public Function LogDocOpen(obj As Object) As Long
On Error GoTo Err_Handler
    'Purpose:   Create a log entry for the form/report being opened.
    'Argument:  The form or report whose opening we are logging.
    'Return:    Primary key value of the log entry. Zero on error.
    'Usage:     For a form, set the On Open property to:    =LogDocOpen([Form])
    '           For a report, set the On Open property to:  =LogDocOpen([Report])
    Dim rs As DAO.Recordset
    Dim lngObjType As Long          'acForm or acReport
    Dim strDoc As String            'Name of the form/report
    Dim lngHWnd As String           'hWnd of the form/report
    
    
    If mbLogDox Then
        strDoc = obj.Name
        lngHWnd = obj.Hwnd
        
        Set rs = DBEngine(0)(0).OpenRecordset("tblLogDoc", dbOpenDynaset, dbAppendOnly)
        rs.AddNew
            rs!OpenDateTime = Now()
            rs!CloseDateTime = Null
            rs!DocTypeID = DocType(obj)
            rs!DocName = strDoc
            rs!DocHWnd = lngHWnd
            rs!ComputerName = ComputerName()
            rs!WinUser = NetworkUserName()
            rs!JetUser = CurrentUser()
            rs!CurView = CurView(obj)

        rs.Update
        rs.Bookmark = rs.LastModified
        LogDocOpen = rs!LogDocID
        rs.Close
    End If
    
Exit_Handler:
    Set rs = Nothing
    Exit Function

Err_Handler:
    Call LogError(Err.Number, Err.Description, conMod & ".LogDocOpen", "Document " & strDoc, False)
    Resume Exit_Handler
End Function

Public Function LogDocClose(obj As Object) As Long
On Error GoTo Err_Handler
    'Purpose:   Update the log entry created when the form/report was opened, to mark it closed.
    '           Creates a new entry if the existing one cannot be found.
    'Argument:  The form or report whose closing we are logging.
    'Return:    Primary key value of the log entry updated/created. Zero on error.
    'Usage:     For a form, set the On Close property to:   =LogDocClose([Form])
    '           For a report, set the On Close property to: =LogDocClose([Report])
    Dim rs As DAO.Recordset
    Dim strSql As String            'SQL statement
    Dim strDoc As String            'Name of the form/report
    Dim strWinUser As String        'Name of the Windows user
    Dim strJetUser As String        'Name of the JET engine user
    Dim strComputer As String       'Name of this workstation
    Dim lngObjType As Long          'acForm or acReport
    Dim lngHWnd As String           'hWnd of the form/report
        
    If mbLogDox Then
        strDoc = obj.Name
        strWinUser = NetworkUserName()
        strComputer = ComputerName()
        lngHWnd = obj.Hwnd
        lngObjType = DocType(obj)
        
        'Get the log entry when this user on this computer opened this form/report (same name, type and hWnd)
        strSql = "SELECT tblLogDoc.* FROM tblLogDoc WHERE ((tblLogDoc.DocTypeID = " & lngObjType & ") AND (tblLogDoc.DocName = """ & strDoc & _
            """) AND (tblLogDoc.DocHWnd = " & lngHWnd & ") AND (tblLogDoc.ComputerName = """ & strComputer & """) AND (tblLogDoc.WinUser = """ & strWinUser & _
            """) AND (tblLogDoc.CloseDateTime Is Null) AND (tblLogDoc.OpenDateTime <= Now())) ORDER BY tblLogDoc.OpenDateTime, tblLogDoc.LogDocID;"
        Set rs = DBEngine(0)(0).OpenRecordset(strSql)
        If rs.RecordCount > 0& Then
            'Log entry found: update as closed.
            rs.Edit
                rs!CloseDateTime = Now()
            rs.Update
        Else
            'Can't find when document was opened: create a new one.
            rs.AddNew
                rs!OpenDateTime = Null
                rs!CloseDateTime = Now()
                rs!DocTypeID = lngObjType
                rs!DocName = strDoc
                rs!DocHWnd = lngHWnd
                rs!ComputerName = strComputer
                rs!WinUser = strWinUser
                rs!JetUser = CurrentUser()
                rs!CurView = CurView(obj)
            rs.Update
        End If
        rs.Bookmark = rs.LastModified
        LogDocClose = rs!LogDocID
        rs.Close
    End If
    
Exit_Handler:
    Set rs = Nothing
    Exit Function

Err_Handler:
    Call LogError(Err.Number, Err.Description, conMod & ".LogDocClose", "Document " & strDoc, False)
    Resume Exit_Handler
End Function

Private Function DocType(obj As Object) As Long
On Error GoTo Err_Handler
    'Purpose:   Return the acObjectType for the obj.
    'Argument:  The form/report to examine.
    'Return:    acForm or acReport. Zero on error.
    
    If TypeOf obj Is Form Then
        DocType = acForm
    ElseIf TypeOf obj Is Report Then
        DocType = acReport
    End If

Exit_Handler:
    Exit Function

Err_Handler:
    Call LogError(Err.Number, Err.Description, conMod & ".DocType")
    Resume Exit_Handler
End Function

Private Function CurView(obj As Object) As Variant
    'Purpose:   Return the CurrentView property of the form/report.
    'Return:    An integer represeting the CurrentView. Null on error.
    'Note:      CurrentView errors for reports earlier than Access 2007.
    
    On Error Resume Next
    CurView = obj.CurrentView
    If Err.Number <> 0& Then CurView = Null
End Function

Private Function NetworkUserName() As String
On Error GoTo Err_Handler
    'Purpose:   Returns the network login name.
    Dim lngLen As Long          'Length of string.
    Dim strUserName As String
    Const lngcMaxFieldSize As Long = 64& 'Length of field to store this data.
    
    'Initialize
    strUserName = String$(254, vbNullChar)
    lngLen = 255&
    
    'API returns a non-zero value if success.
    If apiGetUserName(strUserName, lngLen) <> 0& Then
        lngLen = lngLen - 1&    'Without null termination char.
        If lngLen > lngcMaxFieldSize Then  'Maximum field size
            lngLen = lngcMaxFieldSize
        End If
        NetworkUserName = Left$(strUserName, lngLen)
    End If

Exit_Handler:
    Exit Function

Err_Handler:
    Call LogError(Err.Number, Err.Description, conMod & ".NetworkUserName", , False)
    Resume Exit_Handler
End Function

Private Function ComputerName() As String
On Error GoTo Err_Handler
    'Purpose:   Return the name of this workstation.
    Dim strName As String
    Dim lngLen As Long
    
    lngLen = 16&
    strName = String$(lngLen, vbNullChar)
    
    If apiGetComputerName(strName, lngLen) = 0& Then
        ComputerName = "Unknown"
    Else
        ComputerName = Left$(strName, lngLen)
    End If

Exit_Handler:
    Exit Function

Err_Handler:
    Call LogError(Err.Number, Err.Description, conMod & ".fOSMachineName")
    Resume Exit_Handler
End Function

Private Function LogError(ByVal lngErrNumber As Long, _
    ByVal strErrDescription As String, _
    strCallingProc As String, _
    Optional vParameters As Variant, _
    Optional bShowUser As Boolean = True) As Boolean
    'Purpose:   Substitute for the real error logging routine at:
    
    'If bShowUser Then
        MsgBox "Error " & lngErrNumber & ": " & strErrDescription, vbExclamation, strCallingProc
    'End If
End Function
I have not used modules much so if someone could edit this code and give me ASAP I would appreciate it very much.
Thanks in Advance.
Stan
 

DavidAtWork

Registered User.
Local time
Today, 11:57
Joined
Oct 25, 2011
Messages
699
looks to me like you just need to add an extra line in the code that adds a new record to the recordset
i.e.after the line
rs.AddNew
rs!UserName = Forms!frmLogin!cmbUserName

This line should appear twice, firstly in the LogDocOpen function, and also in the LogDocClose function

David
 

DavidAtWork

Registered User.
Local time
Today, 11:57
Joined
Oct 25, 2011
Messages
699
looks to me like you just need to add an extra line in the code that adds a new record to the recordset
i.e.after the line

Code:
rs.AddNew
    rs!UserName = Forms!frmLogin!cmbUserName

This line should appear twice, firstly in the LogDocOpen function, and also in the LogDocClose function

David
 

smig

Registered User.
Local time
Today, 13:57
Joined
Nov 25, 2009
Messages
2,209
if you have the user name in a table what do you need the Window's user name and the Computer name for ?
 

Users who are viewing this thread

Top Bottom