Results 1 to 3 of 3
  1. #1
    StanJx is offline Novice
    Windows 8 Access 2013
    Join Date
    Dec 2014
    Posts
    7

    Event Logger Module Need some help to add a small part

    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

  2. #2
    June7's Avatar
    June7 is online now VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    52,825
    I don't use API calls to get network username and computer name. I use intrinsic Environ() function. That way don't have compatibility issue with different operating systems (64bit vs 32bit) requiring the PtrSafe parameter.

    Your code shows opening a recordset and populating fields. You want to populate another field of that same recordset?

    rs!UserName = Me.cmbUserName
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  3. #3
    StanJx is offline Novice
    Windows 8 Access 2013
    Join Date
    Dec 2014
    Posts
    7
    Thanks for the help. Its working now.

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 5
    Last Post: 05-09-2014, 08:12 AM
  2. How Can export Large table part by part
    By shabar in forum Import/Export Data
    Replies: 2
    Last Post: 02-04-2013, 06:29 AM
  3. class module vs regular module
    By Madmax in forum Modules
    Replies: 1
    Last Post: 05-01-2012, 03:44 PM
  4. Replies: 4
    Last Post: 05-16-2011, 04:58 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums