在 Excel VBA 中捕获 Outlook 电子邮件发送时间答案

【问题标题】：Capturing Outlook Email Send Time In Excel VBA在 Excel VBA 中捕获 Outlook 电子邮件发送时间
【发布时间】：2017-09-19 15:22:22
【问题描述】：

每当我在 Excel 中执行 VBA 代码时，都会生成一封 Outlook 电子邮件。它不会自动发送，我也不希望它自动发送。电子邮件由某个范围内的单元格值填充（基于 ActiveCell），我想以编程方式捕获手动发送电子邮件时到 ActiveCell.Offset(0, 13)，最好使用我当前的 Excel 程序中的 VBA。

这是我显示电子邮件的代码：

'Send Stock Request:
Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)

With OutMail
    .BodyFormat = olFormatHTML
    .HTMLBody = "My eMail's HTML Body"
    .To = "myrecipients@theiremails.com"
    .CC = ""
    .BCC = ""
    .Subject = "Stock Request"
    .Display
End With

Set OutMail = Nothing
Set OutApp = Nothing

【问题讨论】：

如果在 Excel vba 中不可能（我不知道是否可能），那么也许使用 Outlook vba。有一个发送事件，您可以在其中检查您发送的电子邮件，并将信息存储在 Excel 中。
在这种情况下，您知道我将如何访问该活动吗？我熟悉 Excel 的对象模型，但不幸的是不熟悉 Outlook。
最后发送邮件时是否保证打开Excel文件？
是的，它将在整个过程中打开。

标签： excel vba outlook

【解决方案1】：

可以通过 VBA 完成，但下面的代码必须粘贴到 Outlook 模块而不是 Excel 中，在 Outlook=>ThisOutlookSession 模块中。此外，请确保您在 Outlook 中允许使用宏。

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

Dim Xl As Object ' Excel.Application
Dim Wb As Object ' Excel.Workbook
Set Xl = GetObject(, "excel.application")
Set Wb = Xl.Workbooks("NameOfYourOpenedWorkbook.xlsb")
Wb.Activate
Xl.activecell.Offset(0, 13).Value = Date & " " & Time

End Sub

因此，现在当您手动发送自动创建的电子邮件时，您将在 ActiveCell.Offset(0, 13) 单元格中打开的工作簿中获取日期和时间。

【讨论】：

非常感谢您！我将尝试实现这一点，并让您知道会发生什么。这会影响所有发送的电子邮件还是仅影响通过 Excel 模块创建的电子邮件（如果答案很明显，请原谅我忽略它，因为我在 Outlook 中使用 VBA 的经验很少）？
效果很好！非常感谢您的帮助！
不客气。好问题，它将影响所有发送电子邮件。您可以在 private sub 中添加 if 语句，以便仅在打开特定工作簿时运行其余代码。或者在不使用 Excel 文件时在 Outlook 中禁用宏...
这就是我的想法，但想确认一下。我认为添加 IF 语句来检查电子邮件的主题并且工作簿已打开将很好地为我解决这个问题。再次，非常感谢！

【解决方案2】：

添加对 Outlook 对象模型的 VBA 项目引用，并将此类添加到您的 excel 文件中：

''clsMail
Option Explicit

Public WithEvents itm As Outlook.MailItem
Public DestCell As Range '<< where to put the "sent" message
'you can add other fields here if you need (eg) to 
'  preserve some other info to act on when the mail is sent

Private Sub itm_Send(Cancel As Boolean)
    Debug.Print "Sending mail with subject: '" & itm.Subject & "'"
    DestCell.Value = "Mail sent!"  '<< record the mail was sent
End Sub

然后在您的邮件发送代码中，您可以执行以下操作：

Option Explicit

Dim colMails As New Collection

Sub Tester()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim obj As clsMail

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)

    With OutMail
       .BodyFormat = olFormatHTML
       .HTMLBody = "My eMail's HTML Body"
       .To = "twilliams@theravance.com"
        .CC = ""
        .BCC = ""
        .Subject = "Stock Request"
        .Display
    End With
    'create an instance of the class and add it to the global collection colMails
    Set obj = New clsMail
    Set obj.itm = OutMail
    Set obj.DestCell = ActiveCell.Offset(0, 13) '<< "sent" flag goes here
                                                ' when the user sends the mail
    colMails.Add obj

End Sub

【讨论】：