INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Error Resolution

Emailing Errors Automatically by Turbo
Posted: 6 Aug 03

I have solved a problem that I thought would be a helpful tool to share. As a database manager I want to know when an error occurs in the database. I have built a function (with the help of shared code) that emails the error to me without disrupting the flow of work for the user. Here you go.

Place this code in your sub routine:

Private Sub Whatever()

On Error GoTo errHandler

    Code goes here.

errHandler:
    strErrNum = Err.Number
    strErrDesc = Err.Description
    
    Call EmailError(strErrNum, strErrDesc)
    
End Sub
_______________________________________________

Place this code in a module:

Option Compare Database
Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetActiveWindow Lib "user32.dll" () As Long
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal Msg As Long, wParam As Any, lParam As Any) As Long

Global booIsThisOpen As Boolean
Global strIsThisopen As String

Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Long

On Error Resume Next

    Dim slength As Long, TitleBar As String
    Dim retval As Long
    Static winnum As Integer
    
    booIsThisOpen = False
    winnum = winnum + 1
    slength = GetWindowTextLength(hwnd) + 1
    
    If slength > 1 Then
        TitleBar = Space(slength)
        retval = GetWindowText(hwnd, TitleBar, slength)
            If InStr(TitleBar, strIsThisopen) Then
                booIsThisOpen = True
                Exit Function
            End If
    End If
    
EnumWindowsProc = 1

End Function

Public Function EmailError(strErrNum, strErrDesc)

    Dim objOutlook As Outlook.Application
    Dim objEmail As Outlook.MailItem
    
    'Checks to see if Outlook is running.
    strIsThisopen = "Microsoft Outlook"
    Call EnumWindows(AddressOf EnumWindowsProc, 0)
    
    'If Outook is not open.
    If booIsThisOpen = False Then
        
        'Creates an instance of Outlook.
        Set objOutlook = CreateObject("Outlook.application")
        Set objEmail = objOutlook.CreateItem(olMailItem)
        
        'Creates and sends email.
        With objEmail
            .Importance = olImportanceHigh
            .To = "emailme@here.com"
            .Subject = "Database Error."
            .Body = "The following error occurred in the database at " & Now & ": " & "'Error Number: " & strErrNum & ", Error Description: " & strErrDesc & "'."
            .Send
        End With
        
        'Closes Outlook
        objOutlook.Quit
        
    'If outlook is open.
    Else
        
        'Creates an instance of Outlook.
        Set objOutlook = CreateObject("Outlook.application")
        Set objEmail = objOutlook.CreateItem(olMailItem)
        
        'Creates and sends email.
        With objEmail
            .Importance = olImportanceHigh
            .To = "emailme@here.com"
            .Subject = "Database Error."
            .Body = "The following error occurred in the database at " & Now & ": " & "'Error Number: " & strErrNum & ", Error Description: " & strErrDesc & "'."
            .Send
        End With
    End If
    
    Set objEmail = Nothing
    
    Exit Function

End Function
_______________________________________________

The error trap calls the function "EmailError" and passes the error number and description to the email body. The function then checks to see if outlook is open. Whether Outlook is open or closed this code sends the email and returns Outlook to its prior status,opened or closed.

Place your specific information in the code where you see italics.

Good Luck,

Turbo  

"There is a fine line between confidence and conceit" - Ken Mai


Back to Microsoft: Access Modules (VBA Coding) FAQ Index
Back to Microsoft: Access Modules (VBA Coding) Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close