Question

每当我在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

Answer 1

可以通过VBA完成，但必须在Outlook =＆gt; ThisOutlookSession模块中将以下代码粘贴到Outlook模块而不是Excel中。此外，请确保您在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)单元格中打开的工作簿中获取日期和时间。

Answer 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

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

2 个答案: