Как перехватить события Outlook из приложения Excel

У меня есть рабочая книга, которую по крайней мере 15 человек используют и периодически обновляют, в которой содержится информация о клиенте с электронными письмами в столбце H3:H1500. Используя событие Worksheet_FollowHyperlink, мы можем отправлять электронные письма через наши учетные записи Outlook, которые предварительно написаны и зависят от того, в какой день недели запрашивается заказ (MF, суббота и воскресенье), и код прекрасно работает для генерации сообщений. Моя главная проблема в отслеживании ответов клиентов. Я пытался использовать сабвуфер с записанной датой (функция NOW) и Environ("имя пользователя") всякий раз, когда была выбрана гиперссылка в столбце H, но, поскольку у меня суб-адрес электронной почты установлен на.Display (чтобы люди могли вносить любые изменения в последнюю минуту (при необходимости) он только записывает, кто выбрал гиперссылку (что, по-видимому, часто случается случайно, когда сообщение никогда не отправляется). Я нашел несколько потоков по всему этому форуму и другие, которые ссылаются на создание модуля Class, и я реализовал один, который использовался, чтобы увидеть, будет ли он работать в моем коде, но, добавив его, вся подпрограмма электронной почты стала бесполезной, поэтому я вернулся к старая форма. Поскольку я не очень опытен в VBA (я получил это далеко из-за помощи, проб и ошибок), я понимаю, что некоторые из моих вариантов выбора кода могут показаться глупыми, и если есть лучшие способы сделать это, я открыт для это - я просто знаю, что этот лист работает в основном на данный момент, и я надеюсь, что он может быть улучшен, если это возможно.

Моя текущая электронная почта:

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

Любая помощь приветствуется!

1 ответ

Решение

Вы пытаетесь работать с событиями в Outlook, из потока Excel, действительно очень интересного вопроса, и я не знал, будет ли это возможно. Я думаю, что это поможет вам начать.

Я надеюсь, что смогу отследить пользователя и дату, кто получил доступ к гиперссылке электронной почты и фактически отправил ее.

ПРОБЛЕМА. Гиперссылка открывает другое приложение (Outlook), над которым у вас нет полного контроля. И, по крайней мере, со стороны VBA, вы НЕ имеете контроля над событиями Outlook.

Я подумал, что может быть более простой способ взломать решение, но это был тупик, вы намекали на объект класса, поэтому я подумал, что у меня есть идея, которая может сработать... хотя никогда раньше этого не делал, так что это работа в ходе выполнения.

Чтобы решить эту проблему, я остановлюсь на подходе, который делает:

  1. Убивает гиперссылки, чтобы они не запускали Outlook автоматически
  2. Использовать SelectionChange событие для отправки почты через VBA, а не FollowHyperlink событие
  3. Создайте пользовательский объект класса обработчика событий для Outlook MailItem, который будет перехватывать _Send событие, которое вы можете использовать для регистрации деталей отправки.

Вот коды / инструкции:

Создайте объект класса с именем cMailItem и поместите этот код внутри него:

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

В модуле кода СТАНДАРТ (я называю это HelperFunctions но имя не имеет значения) поставьте этот код, который установит флаг для нашего cMailItem Класс обработчика событий, а также содержит функцию, которая возвращает экземпляр приложения 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

Теперь часть проблемы заключается в том, что гиперссылка имеет приоритет над другими событиями. Чтобы избежать этого, я использую некоторый код, чтобы "убить" гиперссылки. Они будут "ссылаться" только на ячейку, в которой они находятся, но они все равно будут содержать текст для адреса электронной почты.

Вместо использования 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, который был ограничен тем фактом, что он будет перехватывать ЛЮБОЕ событие item_send, это было проблематично, поскольку многозадачные пользователи могли отправлять ложные срабатывания. Пересмотренное решение использует обработчик событий для MailItem объект, который создается во время выполнения и должен избегать этой ловушки.

МОГУТ БЫТЬ ДРУГИЕ ОГРАНИЧЕНИЯ

Например, этот метод на самом деле не обрабатывает "несколько" электронных писем, поэтому, если пользователь нажимает одну ссылку, а затем другую, будет только ОДНА электронная почта, которая существует и может быть отслежена. Если вам нужно обрабатывать несколько писем, используйте общедоступную Collection этого объекта класса, который я сделал для этого похожего вопроса.

Как я уже сказал, это первый раз, когда я пытался использовать WithEvents обработчик между двумя приложениями. Я использовал тему в надстройках для одного приложения и т. Д., Но никогда не связывал два приложения таким образом, поэтому для меня это неизведанная территория.

Другие вопросы по тегам