发送多个电子邮件通知时如何避免VBA运行时错误462?

时间:2019-09-10 15:22:35

标签: excel vba outlook

所以我对excel非常陌生,对VBA还是很陌生。我完全没有编码经验。我设置了一个工作表,以在工作表检测到某些单元格包含某些值(例如“ 75%”和“到期”)时发送电子邮件通知。但是,有时,大约一半的时间,当代码运行时,我收到462运行时错误。

我环顾四周,似乎发现这是因为我没有正确指定代码的元素。问题是,我对编码了解甚少,因此不确定如何解决此问题。理想情况下,有人可以确切地告诉我要对我的代码进行哪些更改,因为我认为它只需要进行一次很小而又容易的调整,而我对此并不了解。

Private Sub Worksheet_Change(ByVal Target As Range)

    Call Check_Project_Progress

End Sub

Private Sub Send_Email(Optional ByVal email_title As String = "")

    Dim olNS As Namespace
    Dim olMail As MailItem

    Set olNS = GetNamespace("MAPI")
    Set olMail = CreateItem(olMailItem)

    With olMail
        .Subject = email_title
        .To = "LearnDataAnalysis@outlook.com"
        .Body = "Value reads 75%"
        .SendUsingAccount = olNS.Accounts.Item(1)
        .Display
        '.Send
    End With

    Set olMail = Nothing
    Set olNS = Nothing

End Sub
Private Sub Send_Email2(Optional ByVal email_title As String = "")

    Dim olNS As Namespace
    Dim olMail As MailItem

    Set olNS = GetNamespace("MAPI")
    Set olMail = CreateItem(olMailItem)

    With olMail
        .Subject = email_title
        .To = "LearnDataAnalysis@outlook.com"
        .Body = "PLA determination due"
        .SendUsingAccount = olNS.Accounts.Item(1)
        .Display
        '.Send
    End With

    Set olMail = Nothing
    Set olNS = Nothing

End Sub
Private Sub Check_Project_Progress()

    Dim LastRow As Long, RowNumber As Long
    Dim ws As Worksheet

    Set ws = ActiveSheet

    With ws

        LastRow = 500

        If 4 > LastRow Then Exit Sub

        For RowNumber = 4 To LastRow
            If .Cells(RowNumber, "AB").Value = 0.75 And .Cells(RowNumber, "AD").Value <> "S" Then
                .Cells(RowNumber, "AD").Value = "S"
                .Cells(RowNumber, "AE") = "Email sent on:" & Now()
                Call Send_Email(.Cells(RowNumber, "C").Value & " is approaching deadline")
            End If
        If 4 > LastRow Then Exit Sub

            If .Cells(RowNumber, "AC").Value = "Due" And .Cells(RowNumber, "AD").Value <> "S,S" Then
                .Cells(RowNumber, "AD").Value = "S,S"
                .Cells(RowNumber, "AF") = "Email sent on:" & Now()
                Call Send_Email2(.Cells(RowNumber, "C").Value & " has met deadline")
            End If
        Next RowNumber

    End With

    Set ws = Nothing

End Sub

同样,该错误消息是运行时错误462。我们将不胜感激,如果我的代码格式不正确,请提前向我道歉。我几乎不知道我在做什么。

1 个答案:

答案 0 :(得分:0)

由于该代码无法连接到Outlook应用程序,因此您收到该错误。

尝试一下。我已经为您展示了Send_Email。也将其调整为Send_Email2

Private Sub Send_Email(Optional ByVal email_title As String = "")
    Dim olNS As Object
    Dim olMail As Object
    Dim OutlookApp As Object

    '~~> Establish an Outlook application object
    On Error Resume Next
    Set OutlookApp = GetObject(, "Outlook.Application")

    If Err.Number <> 0 Then
        Set OutlookApp = CreateObject("Outlook.Application")
    End If
    Err.Clear
    On Error GoTo 0

    '~~> Check if we managed to connect to Outlook
    If OutlookApp Is Nothing Then
        MsgBox "unable to connect to outlook"
        Exit Sub
    End If

    Set olNS = OutlookApp.GetNamespace("MAPI")
    Set olMail = OutlookApp.CreateItem(0)

    With olMail
        .Subject = email_title
        .To = "LearnDataAnalysis@outlook.com"
        .Body = "Value reads 75%"
        .SendUsingAccount = olNS.Accounts.Item(1)
        .Display
        '.Send
    End With
End Sub