首页 > 解决方案 > Outlook 不可用时处理错误

问题描述

我有一个在办公室时可以使用的宏。

从远程系统工作时,我们没有 Outlook,它会生成一个错误,即无法创建 Outlook 邮件。

我需要一个 MsgBox,在 Remote 上说没有 Outlook,然后退出 sub。

Sub Mail_workbook_Outlook_1()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim bodystr As String
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    bodystr = "Test"
    
    ActiveWorkbook.Save

    On Error Resume Next
    
    With OutMail
        .To = Worksheets("Test").Range("D25")
        .CC = Worksheets("Test").Range("D26")
        .BCC = ""
        .Subject = Worksheets("Test").Range("D10")
        .HTMLbody = bodystr
        .Attachments.Add ActiveWorkbook.FullName
        .Send  
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

我试过了:

    Set OutApp = CreateObject("Outlook.Application")
    If OutApp Is Nothing Then
        MsgBox "Outlook is not open, Open Outlook and try again!"
        Exit Sub
    Else
        Set OutMail = OutApp.CreateItem(0)
    End If
    
    bodystr = "Test"
        
    ActiveWorkbook.Save
    
    On Error Resume Next
        
    With OutMail
        .To = Worksheets("Test").Range("D25")
        .CC = Worksheets("Test").Range("D26")
        .BCC = ""
        .Subject = Worksheets("Test").Range("D10")
        .HTMLbody = bodystr
        .Attachments.Add ActiveWorkbook.FullName
        .Send  
    End With
    On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

标签: excelvbaoutlook

解决方案


请尝试此代码:

   On Error Resume Next
     Set OutApp = CreateObject("Outlook.Application")
     Set Outmail = Outapp.Createitem(0)
    If Err <> 0 Then
        Err.Clear: On Error GoTo 0
        MsgBox "No  Outlook Application installed, or not configured": Exit Sub
    End If
    On Error GoTo 0

推荐阅读