当VBA代码出错时自动发送电子邮件

时间:2012-05-16 16:38:53

标签: vba error-handling outlook-vba

我正在编写一个VBA宏,供其他不是VBA用户的人使用。因此,我想在代码中嵌入一个系统,当代码抛出错误时,会自动向我发送一封来自宏用户的Outlook帐户的电子邮件。这可以用VBA吗?此外,用户不会拥有其帐户的管理员权限,这会产生问题吗?在此先感谢您的帮助!

编辑 - 我现在知道这是可能的,并且还有相同的vba代码(见下文)。但是,我们可以消除当我们尝试自动发送电子邮件时弹出的“安全警告框”。另外,我想附上错误的文件和电子邮件。如果我得到一些帮助就好了,谢谢!

1 个答案:

答案 0 :(得分:3)

试试这个。的 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 = "abc@abc.com"
        .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

<强>后续

  

有没有办法我还可以附加有宏的excel文件?我将编辑主要问题以反映这一点。 - hardikudeshi 5分钟前

试试这个。

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 = "abc@abc.com"
        .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