Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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!

like image 610
hardikudeshi Avatar asked Mar 05 '26 10:03

hardikudeshi


1 Answers

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
like image 161
Siddharth Rout Avatar answered Mar 07 '26 03:03

Siddharth Rout



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!