在Excel VBA中捕获Outlook电子邮件发送时间
每当我在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 它可以通过VBA完成，但下面的代码必须粘贴在Outlook模块而不是Excel中，在Outlook => ThisOutlookSession模块中。 此外，请确保您允许Outlook中的macros。
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
所以，现在当您手动发送自动创build的电子邮件时，您将在ActiveCell.Offset(0, 13)单元格中打开的工作簿中获取date和时间。
将一个VBA项目引用添加到Outlook对象模型，并将此类添加到您的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