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
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:
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
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
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
Thanks in Advance.
Stan