CODEWITHSUNDEEP
vbaerror-handlingoutlook
hardikudeshi
hardikudeshi

Reputation: 1491

Automatically send an Email when the VBA code gives an error

I am writing a VBA macro which is to be used by others who will not be VBA users. Hence, I would like to embed a system in the code which, when the code throws an error, automatically sends me an email from the outlook account of user of the macro. Would this be possible with VBA? Also, the user would not be having admin access to their account, will this create an issue? Thanks in advance for your help on this!

EDIT - I now know that this is possible and also have a vba code for the same (see below). However, can we eliminate the "Security warning box" that pops up when we try to send the email automatically. Also, I would like to attach the erring file along with the email. It would be great if I get some help on this, Thanks!

Upvotes: 3

Views: 13767

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149305

Try this. UNTESTED

Option Explicit

Sub Sample()
    On Error GoTo Whoa

    '
    '~~> Rest of the Code
    '

    Exit Sub
 Whoa:
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = "[email protected]"
        .Subject = "Error Occured - Error Number " & Err.Number
        .Body = Err.Description

        .Display '~~> Change this to .Send for sending the email
    End With

    Set OutApp = Nothing: Set OutMail = Nothing
End Sub

FOLLOWUP

Is there a way I can also attach the excel file having the macro? I will edit main question as well to reflect this. – hardikudeshi 5 mins ago

Try this.

Option Explicit

Private Declare Function GetTempPath _
Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long

Private Const MAX_PATH As Long = 260

Sub Sample()
    Dim OutApp As Object, OutMail As Object
    Dim wb As Workbook

    On Error GoTo Whoa

    '
    '~~> Rest of the Code
    '

    Exit Sub
 Whoa:
    Set wb = ThisWorkbook

    Application.DisplayAlerts = False
    wb.SaveAs TempPath & "ErroringFile.xls", FileFormat:= _
    xlNormal
    Application.DisplayAlerts = True

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = "[email protected]"
        .Subject = "Error Occured - Error Number " & Err.Number
        .Body = Err.Description
        .Attachments.Add TempPath & "ErroringFile.xls"

        .Display '~~> Chnage this to .Send for sending the email
    End With

    Set OutApp = Nothing: Set OutMail = Nothing
End Sub

Function TempPath() As String
    TempPath = String$(MAX_PATH, Chr$(0))
    GetTempPath MAX_PATH, TempPath
    TempPath = Replace(TempPath, Chr$(0), "")
End Function

Upvotes: 4

Related Questions