error handling (1 Viewer)

Exit_Err_Handler:
Exit Sub
Err_Handler:
MsgBox Err.Description, vbExclamation + vbOKOnly, "Error #" & Err.Number
Open "C:\Documents And Settings\user\Desktop\Error.log" For Output As #1
Print #1, Err.Description & Err.Number
Close #1
Resume Exit_Err_Handler

    Open FilePath For [b]Append[/b] As #1
        Print #1, "YourMessage"
    Close #1

Option Compare Database

Public Sub LogActivity(strActivity As String, Optional ActivityInfo As String)

    Dim fileNum As Integer
    Dim filePath As String
    Dim strOut As String
    Dim LogFile As String
    Dim fs, File
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateFalse = 0

    
    filePath = GetFilePath(CurrentDb.Name)
    LogFile = filePath & "Activity.log"
    
    strOut = UCase$(Format(Now, "dd-MMM-yy hh:nn:ss")) & vbTab & fGetUserName & vbTab & strActivity & vbTab & ActivityInfo
    strOut = TrimNull(strOut)
    
[COLOR=Green]    'Get an available file number[/COLOR]
    fileNum = FreeFile
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    If Not fs.FileExists(LogFile) Then
        Set File = fs.CreateTextFile(LogFile, True)
        File.writeline ("     Time" & vbTab & vbTab & "User" & vbTab & "Activity" & vbTab & "Description")
        File.writeline ("-------------------------------------------------------------")
        File.Close
    End If
    
    Set File = fs.opentextfile(LogFile, ForAppending, TristateFalse)
    File.writeline strOut
    File.Close
[COLOR=Green]    '---The Following outputs as well---
    'Open LogFile For Append As fileNum
    'Write #fileNum, strOut
    'Close #fileNum[/COLOR]

End Sub

Public Function GetFilePath(strFileName As String) As String
    Dim intCounter As Integer
      
    For intCounter = Len(strFileName) To 1 Step -1
        If Mid$(strFileName, intCounter, 1) = "\" Then
            Exit For
        End If
    Next intCounter
    
    GetFilePath = Left$(strFileName, intCounter)
End Function


Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
        TrimNull = Left(strItem, intPos - 1)
    Else
        TrimNull = strItem
    End If
End Function

Option Compare Database

Private Declare Function apiGetUserName _
    Lib "advapi32.dll" _
    Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long


[COLOR=Green]'_ This function is called from anywhere the programmer wishes _
 _ to get user's login name.  The function returns the login__ _
 _ name as a string. _________________________________________ _
'[/COLOR]
Function fGetUserName() As String

    Dim lngLength As Long
    Dim lngX As Long
    Dim strUser As String
    
    strUser = String$(254, 0)
    lngLength = 255
    lngX = apiGetUserName(strUser, lngLength)
    
    If (lngX > 0) Then
        fGetUserName = Left$(strUser, lngLength - 1)
    Else
        fGetUserName = vbNullString
    End If
End Function