检测Excel何时通过MailEnvelope而非外部Outlook发送电子邮件

时间:2018-12-27 23:37:28

标签: excel vba

我已经创建了一个工作簿,我的团队使用该工作簿发送故障的电子邮件通讯。为了能够进行完整性检查,我只显示电子邮件而不是发送电子邮件,因此为什么我要激活发送通信的工作表。我想要做的是检测何时发送邮件,然后将用户返回到主工作表,并将workbook.saved属性设置为true(因为当用户选择发送电子邮件的选项时,我自动保存工作簿,但是更改工作表使Excel表现出色认为它没有保存)。无论如何,当excel发送电子邮件时是否可以捕获,以便我可以据此触发宏运行?

我尝试将代码放入工作表Worksheet_Change子目录中,但是通过excel / MailEnvelope发送邮件消失似乎不算作工作表更改事件。

Public Sub sendEmail()
'Working in Excel 2002-2016
'Adapted from https://www.rondebruin.nl/win/s1/outlook/bmail3.htm
    Dim emailSubject As String
    Dim emailUpdateNumber As Integer
    Dim emailUpdateType As String
    Dim emailTestAddress As Range
    Dim additionalEmails As String


    On Error GoTo StopMacro

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    setGlobalVariables ' sets all variables used in more than one sub
    copyComms
    finalCommsWs.Activate
    'Note: if the range is one cell it will send the whole worksheet, multicells will send range only
    Set sendRng = finalCommsWs.Range("A1")

    emailUpdateType = getEmailType


    emailSubject = emailUpdateType & " - " & emailCustomer & " - " & emailPriority & " - " & _
         emailTicketNo & " - " & emailDescription

    If runEmailRecipients <> "" Then
        additionalEmails = "; " & runEmailRecipients
    Else
        additionalEmails = ""
    End If

    'Create the mail and show it
    With sendRng

        ThisWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope


            With .Item
                Select Case emailPriority
                    Case Is = "Case1"
                        If ValidUser Then
                            .SentOnBehalfOfName = "TeamNamme"
                            emailAddress = "Team@email"
                        Else
                            .SentOnBehalfOfName = "TeamNamme"
                            emailAddress = "Team@email"
                        End If
                        .BCC = "sampleEmailList" & additionalEmails
                    Case Is = "Case2"
                        .SentOnBehalfOfName = "TeamNamme"
                        emailAddress = "Team@email"
                        .BCC = "sampleEmailList" & additionalEmails
                    Case Else
                        .SentOnBehalfOfName = "TeamNamme"
                        emailAddress = "Team@email"
                        .BCC = "sampleEmailList" & additionalEmails
                End Select
                .CC = ""
                .Subject = emailSubject
            End With

        End With
    End With

StopMacro:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
setGlobalVariables

If sendingEmail = False And ThisWorkbook.EnvelopeVisible = False Then
    runWs.Activate
    ThisWorkbook.Saved = True
End If

End Sub

0 个答案:

没有答案