如何从 Excel 应用程序捕获 Outlook 事件

Question

我有一个至少有 15 个人使用并定期更新的工作簿，其中包含客户信息和 H3:H1500 列中的电子邮件。使用 Worksheet_FollowHyperlink 事件，我们可以通过我们的 Outlook 帐户发送电子邮件，这些电子邮件是预先编写的并且取决于一周中的哪一天请求订单（M-F，周六和周日）并且代码可以很好地生成消息. 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,但由于我将电子邮件子设置为 .Display（这样人们可以在需要时进行最后一分钟的调整）它只记录谁选择了超链接（当消息从未真正发送时，这显然是偶然发生的） .我在这个论坛和其他论坛中发现了几个线程和其他引用创建 Class 模块的线程，我实现了一个用于查看它是否可以在我的代码中工作的线程，但是通过添加它，整个电子邮件子变得无用所以我恢复到原来的形式。由于我在 VBA 方面不是很有经验（由于帮助和反复试验，我已经走到这一步），我意识到我选择的一些代码可能看起来很愚蠢，如果有更好的方法来做到这一点，我对此持开放态度 - 我只知道，这个 sheet 目前 大部分 有效，我希望它可以得到改进，如果可能的话。

我当前的电子邮箱是：

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 中，我应该在开始之前包含它 - 它现在对我来说工作正常，所以我不确定为什么它没有编译...]

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

感谢任何帮助！

Answer 1

您正尝试在 Excel 线程中处理 outlook 中的事件，这个问题真的非常有趣，我不知道这是否可行。我想这会让你入门。

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

问题： hyperlink 正在打开另一个您无法完全控制的应用程序 (Outlook)。至少在 VBA 方面，您无法控制 Outlook 事件。

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

为了解决这个问题，我采用了一种方法：

杀死 hyperlink，这样它们就不会自动启动 Outlook
使用 SelectionChange 事件通过 VBA 而不是 FollowHyperlink 事件发送邮件
为 Outlook MailItem 创建一个自定义事件处理程序 class 对象，它将捕获 _Send 事件，然后您可以使用它来记录发送的详细信息。

这里是codes/instructions:

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

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 事件处理程序 class 并且还包含 returns Outlook 应用程序实例的功能。

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

现在，部分问题在于 hyperlink 遵循的方式优先于其他事件。为了避免这种情况，我使用了一些代码来 "kill" hyperlinks。它们将 "link" 仅发送到它们所在的单元格，但它们仍将包含电子邮件地址的文本。

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

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

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 应用程序事件处理程序 class 的原始解决方案对此进行了修改，这是由于它会捕获 ANY item_send 事件，这是有问题的，因为多任务用户会发送误报。修改后的解决方案为在运行时创建的 MailItem 对象使用事件处理程序，应该避免该陷阱。

可能还有其他限制

例如，此方法并不能真正处理 "multiple" 封电子邮件，因此如果用户单击一封 link，然后单击另一封，则只有一封电子邮件存在并且可以被跟踪。如果您需要处理多封电子邮件，请使用此 class 对象的 public Collection，我为 .

所做的

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

如何从 Excel 应用程序捕获 Outlook 事件

How to Trap Outlook Events from Excel Application

excel

outlook

vba