Как перехватить события 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.
Я подумал, что может быть более простой способ взломать решение, но это был тупик, вы намекали на объект класса, поэтому я подумал, что у меня есть идея, которая может сработать... хотя никогда раньше этого не делал, так что это работа в ходе выполнения.
Чтобы решить эту проблему, я остановлюсь на подходе, который делает:
- Убивает гиперссылки, чтобы они не запускали Outlook автоматически
- Использовать
SelectionChange
событие для отправки почты через VBA, а неFollowHyperlink
событие - Создайте пользовательский объект класса обработчика событий для 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
обработчик между двумя приложениями. Я использовал тему в надстройках для одного приложения и т. Д., Но никогда не связывал два приложения таким образом, поэтому для меня это неизведанная территория.