如何从 Excel 应用程序捕获 Outlook 事件 [英] How to Trap Outlook Events from Excel Application

问题描述

我有一个至少有 15 人使用并定期更新的工作簿，其中包含客户信息以及 H3:H1500 列中的电子邮件.使用 Worksheet_FollowHyperlink 事件，我们可以通过我们预先编写的 Outlook 帐户发送电子邮件，这些电子邮件取决于请求订单的一周中的哪一天(周一至周五、周六和周日)，并且代码可以很好地生成消息.我的主要问题是跟踪对客户端的响应.我尝试使用录制日期(现在的函数)和环境(用户名")，只要选择H列中的超链接，而且就像我拥有的​​那样电子邮件子设置为 .Display(因此人们可以在最后一刻进行调整，如果需要)它只记录谁选择了超链接(当消息从未真正发送时，这显然是偶然发生的).我在这个论坛中发现了几个线程，其他人引用了创建 Class 模块，我实现了一个用于查看它是否可以在我的代码中工作的线程，但是通过添加它，整个电子邮件子变得无用，所以我又回到了旧形式.由于我在 VBA 方面的经验并不丰富(由于帮助和反复试验，我已经走到了这一步)，我意识到我的一些代码选择可能看起来很愚蠢，如果有更好的方法来做到这一点，我愿意接受它 - 我只知道，这张表目前主要有效，如果可能的话，我希望它可以改进.

I have a workbook that at least 15 people use and update periodically that contains client information with emails within column H3:H1500. Using the Worksheet_FollowHyperlink event, we can send emails through our Outlook accounts that are pre-written and dependent upon what day of the week an order is requested (M-F, Saturday and Sunday) and the code works just fine to generate messages. My main problem is in tracking responses to clients. I tried having a sub that recorded date (NOW function) and Environ("username") whenever the hyperlink within column H was selected, but as I have the e-mail sub set to .Display (so people can make any last minute adjustments, if needed) it only records who selected the hyperlink (which, apparently happens a lot on accident when the message is never actually sent). I had found several threads throughout this forum and others that reference creating a Class module and I implemented one that was used to see if it would work in my code, but by adding it, the entire email sub was rendered useless so I reverted back to the old form. As I am not extremely experienced in VBA (I have gotten this far due to help and trial and error), I realize that some of my choices of code may seem silly, and if there are better ways to do this, I am open to it - I just know that, this sheet works mostly for now and I hope it can be improved, if possible.

我目前的电子邮件子地址是:

My current email sub is:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim Body1, Body2, Body3 As String
Dim olApp As Outlook.Application
Dim OlMail As Outlook.MailItem

On Error Resume Next
Application.EnableEvents = False

Set olApp = GetObject(,"Outlook.Application")

Do While olApp.Inspectors.Count = 0
DoEvents

Loop

Set olMail = olApp.Inspectors.Item(1).CurrentItem

With olMail

Body1 = "This is my weekday text"
Body2 = "This is my Saturday text"
Body3 = "This is my Sunday text"

.Subject = "Subject"
.Attachemnts.Add "C:Path"
.CC = Target.Range.Offset(0,4).Text
.BCC = ""

If Target.Range.Offset(0,5).Text = "No" Then
.Body1
If Target.Range.Offset(0,5).Text = "Yes" Then
.Body2
If Target.Range.Offset(0,5).Text = "Sunday" Then
.Body3

.Display
End With

forward:
Application.EnableEvents = True
Exit Sub
halt:
MsgBox Err.Description
Resume forward
End Sub

[上面的代码在 Excel VBE 中，下面的代码在 Outlook VBE 中，我应该在开始之前包含它 - 它现在对我来说工作正常，所以我不确定为什么它没有编译...]

[The above code is in the Excel VBE, the following code is in the Outlook VBE, I should have included that before starting - it is working fine for me right now, so I am not sure why it is not compiling...]

Function GetCurrentItem() As Object
Dim objApp As Application

Set objApp = CreateObject("Outlook.Application")
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
Set objApp = Nothing
End Function

感谢任何帮助！

推荐答案

您正尝试在 Outlook 中处理来自 Excel 线程的事件，这真的很有趣，但我不知道这是否可行.我想这会让你开始.

You are trying to work with events in outlook, from an Excel thread, really really interesting Q and I didn't know if it would be possible. I think this will get you started.

我希望能够跟踪访问电子邮件超链接并实际发送它的用户和日期.

I am hoping to be able to track the user and date of who accessed the email hyperlink and actually sent it.

问题: 超链接正在打开另一个应用程序 (Outlook)，您无法完全控制该应用程序.至少从 VBA 方面来看，您无法控制 Outlook 事件.

PROBLEM: The hyperlink is opening another application (Outlook), over which you don't have full control. And at least from the VBA side, you do NOT have control over the Outlook events.

我认为可能有一种更简单的方法来破解一个解决方案，但那是一个死胡同，你暗示了类对象，所以我想我有一个可能有用的想法......不过以前从未这样做过，所以这是一项正在进行的工作.

I thought there may be an easier way to hack around a solution but that was a dead end, you had hinted at class object, so I figured I had an idea that might work... never done this before though, so it's a work in progress.

为了解决这个问题，我选择了一种方法:

1. 取消超链接，使它们不会自动启动 Outlook
2. 使用 SelectionChange 事件通过 VBA 而不是 FollowHyperlink 事件发送邮件
3. 为 Outlook MailItem 创建自定义事件处理程序类对象，该对象将捕获 _Send 事件，然后您可以使用该事件记录发送的详细信息.

1. Kills the hyperlinks so that they don't automatically launch Outlook
2. Use the SelectionChange event to send the mail via VBA rather than the FollowHyperlink event
3. Create a custom event handler class object for an Outlook MailItem which will trap the _Send event, which you can then use to log the details of the send.

以下是代码/说明:

创建一个名为 cMailItem 的类对象并将此代码放入其中:

Create a class object called cMailItem and put this code inside it:

Option Explicit
'MailItem event handler class
Public WithEvents m As Outlook.MailItem

Public Sub Class_initialize()

    Set m = olApp.CreateItem(0)

End Sub

Private Sub m_Send(Cancel As Boolean)

        Debug.Print "Item was sent by " & Environ("Username") & " at " & Now()
        Call ReleaseTrap

End Sub

在STANDARD代码模块(我称之为HelperFunctions，但名称无关紧要)中放入这段代码，它将为我们的设置一个标志cMailItem Event Handler 类，还包含返回 Outlook Application 实例的函数.

In a STANDARD code module (I call this one HelperFunctions but the name doesn't matter) put this code, which will set a flag for our cMailItem Event Handler class and also contains the function which returns the instance of Outlook Application.

Option Explicit
'#################
'NOTE: The TrapEvents should be called when the Forms are initialized
'NOTE: The ReleaseTrap should be called when the Forms are closed
Public olApp As Outlook.Application
Public cMail As New cMailItem
Public TrapFlag As Boolean

Sub TrapEvents()
If Not TrapFlag Then
   Set olApp = GetApplication("Outlook.Application")
   TrapFlag = True
End If
End Sub

Sub ReleaseTrap()
If TrapFlag = True Then
   Set olApp = Nothing
   Set cMail = Nothing
   TrapFlag = False
End If
End Sub

Function GetApplication(Class As String) As Object
'Handles creating/getting the instance of an application class
Dim ret As Object

On Error Resume Next

Set ret = GetObject(, Class)
If Err.Number <> 0 Then
    Set ret = CreateObject(Class)
End If

Set GetApplication = ret

On Error GoTo 0

End Function

现在，部分问题在于超链接跟随优先于其他事件的方式.为了避免这种情况，我使用了一些代码来杀死"超链接.它们只会链接"到它们所在的单元格，但它们仍将包含电子邮件地址的文本.

Now, part of the problem is the way that the hyperlink follow takes precedence over other events. To avoid that, I use some code to "kill" the hyperlinks. They will "link" only to the cell wherein they reside, but they will still contain the text for the email address.

我没有使用 FollowHyperlink 事件，而是使用 SelectionChange 事件来调用另一个发送邮件的过程.

Instead of using the FollowHyperlink event, I use the SelectionChange event to call another procedure which sends the mail.

在您的 WORKSHEET 模块中，放置以下事件处理程序和 SendMail 过程:

In your WORKSHEET module, put the following event handlers AND the SendMail procedure:

Option Explicit

Private Sub Worksheet_Activate()
'Converts Mailto hyperlinks so that they do NOT
' automatically open Outlook MailItem

    Dim h As Hyperlink

    For Each h In ActiveSheet.Hyperlinks
        If h.Address Like "mailto:*" Then
            h.ScreenTip = h.Address
            h.Address = ""
            h.SubAddress = h.Range.Address
        End If

    Next

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Disable Excel events
Application.EnableEvents = False

    If Target.Cells.Count <> 1 Then GoTo EarlyExit
    If Target.Hyperlinks.Count <> 1 Then GoTo EarlyExit

    'Send mail to the specified recipient/etc.
    Call SendMail(Target)

EarlyExit:
'Re-enable events:
Application.EnableEvents = True

End Sub
Private Sub SendMail(Target As Range)

Dim Body1$, Body2$, Body3$
Dim OlMail As Outlook.MailItem
Const OLMAILITEM As Long = 0

'Set our Outlook event trap
Call TrapEvents

'CREATE the mailitem
Set OlMail = cMail.m 

With OlMail

    Body1 = "This is my weekday text"
    Body2 = "This is my Saturday text"
    Body3 = "This is my Sunday text"

    .To = Target.Text
    .Subject = "Subject"
    '.Attachemnts.Add "C:Path"
    .CC = Target.Offset(0, 4).Text
    .BCC = ""

    .Display
End With


End Sub

关于修订答案的说明

我从使用 Outlook 应用程序事件处理程序类的原始解决方案修改了这个，该解决方案受到它会捕获 ANY item_send 事件这一事实的限制，这是有问题的，因为多任务用户会发送误报.修改后的解决方案为 MailItem 对象使用了一个事件处理程序，该对象在运行时创建，应该避免这个陷阱.

I revised this from the original solution which used an Outlook Application event handler class, which was limited by the fact that it would trap ANY item_send event, this was problematic because multi-tasking users would send false positives. The revised solution uses an event handler for the MailItem object which is created at run-time, and should avoid that pitfall.

可能还有其他限制

例如，此方法并不能真正处理多"封电子邮件，因此如果用户单击一个链接，然后单击另一个链接，则将只有一封电子邮件存在并可被跟踪.如果您需要处理多封电子邮件，请使用此类对象的公共 Collection，这是我为 这个类似的问题.

For example, this method does not really handle "multiple" emails, so if the user clicks one link, and then another, there will only be ONE email that exists and can be tracked. If you need to handle multiple emails, use a public Collection of this class object, which I did for this similar question.

正如我所说，这是我第一次尝试在两个应用程序之间使用 WithEvents 处理程序.我在单应用插件等中使用过主题，但从未以这种方式绑定两个应用程序，所以这对我来说是未知的领域.

As I said, this is the first time I've ever attempted to use a WithEvents handler between two applications. I've used theme in single-application Add-Ins, etc., but never binding two applications in this manner, so it's uncharted territory for me.

这篇关于如何从 Excel 应用程序捕获 Outlook 事件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！