IN THE SPOTLIGHT: MDE to MDB Conversion Service
(also supports: ACCDE to ACCDB, ADE to ADP, etc)
IN THE SPOTLIGHT: Access Database Repair Service
An in-depth repair service for corrupt Microsoft Access files
IN THE SPOTLIGHT: vbWatchdog
VBA error handling just got easier...
" vbWatchdog is off the chart. It solves a long standing problem of how to consolidate error handling into one global location and avoid repetitious code within applications. "
- Joe Anderson,
Microsoft Access MVP
Meet Shady, the vbWatchdog mascot watching over your VBA code →
(courtesy of Crystal Long, Microsoft Access MVP)
IN THE SPOTLIGHT: vbMAPI
An Outlook / MAPI code library for VBA, .NET and C# projects
Get emails out to your customers reliably, and without hassle, every single time.
Use vbMAPI alongside Microsoft Outlook to add professional emailing capabilities to your projects.
IN THE SPOTLIGHT: Code Protector
Standard compilation to MDE/ACCDE format is flawed and reversible.
Provided by Allen Browne, February 2009
This is the code for the utility described in Log usage of forms and reports.
Option Compare Database Option Explicit 'Purpose: Log when your forms/reports are opened/closed. 'Author: Allen Browne 'Usage: Open/close events of forms/reports call LogDocOpen() and LogDocClose() 'Documentation: http://allenbrowne.com/AppLogDocUse.html '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 Function apiGetUserName Lib "advapi32.dll" _ Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long Private Declare 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: ' http://allenbrowne.com/ser-23a.html 'If bShowUser Then MsgBox "Error " & lngErrNumber & ": " & strErrDescription, vbExclamation, strCallingProc 'End If End Function
Home | Index of tips | Top |
Rate this article:
This is a cached tutorial, reproduced with permission.
iTech Masters | VAT: GB202994606 | Terms | Sitemap | Newsletter