发送第一封电子邮件后自动发送第二封电子邮件(Excel-VBA-Code)

时间:2017-06-30 12:06:36

标签: excel excel-vba email outlook vba

我有以下VBA代码发送电子邮件:

Sub First_Email()
    If ExitAll = False Then
        Dim OApp As Object, OMail As Object, signature As String
        Set OApp = CreateObject("Outlook.Application")
        Set OMail = OApp.CreateItem(0)
            With OMail
            .Display
            End With
            signature = OMail.HTMLbody
            With OMail
            .To = "test@test.de"
            .Subject = "First E-Mail"
            .HTMLbody = "<p> Once I click on the send button for this E-Mail I want that the E-Mail in the code below is sent as well.</p>"
            End With
        Set OMail = Nothing
        Set OApp = Nothing
    Else
    End If
End Sub

此代码使用上述电子邮件打开Outlook。由于用户在发送之前仍有机会修改电子邮件,因此代码不会自动发送电子邮件。

用户点击发送按钮后,系统会发送电子邮件。现在,我想实现一旦用户点击第一封电子邮件的发送按钮,下面的电子邮件也会自动发送:

Sub Second_Email()
    If ExitAll = False Then
        Dim OApp As Object, OMail As Object, signature As String
        Set OApp = CreateObject("Outlook.Application")
        Set OMail = OApp.CreateItem(0)
            With OMail
            .Display
            End With
            signature = OMail.HTMLbody
            With OMail
            .To = "test@test.de"
            .Subject = "Second E-Mail"
            .HTMLbody = "<p> Once I click on the send button for the first E-Mail I want that this E-Mail is sent as well.</p>"
            .send
            End With
        Set OMail = Nothing
        Set OApp = Nothing
    Else
    End If
End Sub

与第一封电子邮件相比,用户在发送第二封电子邮件之前没有机会对其进行监控。用户点击第一封电子邮件的发送按钮后,应立即发送。

一旦用户点击第一封电子邮件中的发送按钮,您知道如何自动发送第二封电子邮件吗?

1 个答案:

答案 0 :(得分:0)

您可以在Outlook中使用ItemSend。在ThisOutlookSession模块中。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    If Item.To = "test@test.de" Then

        If Item.Subject = "First E-Mail" Then

            Set OMail = CreateItem(0)

            With OMail
                .To = "test@test.de"
                .Subject = "Second E-Mail"
                .HTMLbody = "<p> Once I click on the send button for the first E-Mail I want that this E-Mail is sent as well.</p>"
                .send
            End With

        End If
    end if

End Sub

注意:这将在所有邮件上运行,而不仅仅是在Excel中由First_Email发起的邮件。