Outlook VBA event handler not called - vba

I have the following ThisOutlookSession in Outlook:
Public Sub Application_Startup()
Call GetItemsFolderPath.Initialize
End Sub
And the following GetItemsFolderPath class module:
Public WithEvents myOlExp As Outlook.Explorer
Public Sub Initialize()
Set myOlExp = Application.ActiveExplorer
End Sub
Private Sub myOlExp_SelectionChange()
MsgBox "Hello, world"
End Sub
I'm basically following the docs from https://learn.microsoft.com/en-ca/office/vba/api/Outlook.Explorer.SelectionChange
The code compiles BUT it never shows the MsgBox
Restarting Outlook so Application_Startup is called didn't work
Manually executing the Application_Startup macro didn't help either
Any ideas - what am I doing wrong?

When adding Dim GetItemsFolderPath As New GetItemsFolderPath in global space, the code work as it should, displaying the messagebox when you switch folder in Outlook.
ThisOutlookSession:
Option Explicit
Dim GetItemsFolderPath As New GetItemsFolderPath 'Instantiate the class
'***************************************************
'* Outlook start
'*
Public Sub Application_Startup()
Call GetItemsFolderPath.Initialize
End Sub
Class module GetItemsFolderPath:
Option Explicit
Public WithEvents myOlExp As Outlook.Explorer
Public Sub Initialize()
Set myOlExp = Application.ActiveExplorer
End Sub
Private Sub myOlExp_SelectionChange()
MsgBox "Hello, world"
End Sub

I ran into the following problem:
https://learn.microsoft.com/en-us/outlook/troubleshoot/deployment/macros-in-this-project-disabled-outlook

Related

Outlook VSTO App - VB - BeforeReminderShow event not working

I am performing some actions on Outlook's Application_Reminder event. After actions are done, I want to dismiss/remove the reminder (as not to run actions later unintentionally due to second reminder of appointment) with the codes below but breakpoints not hit in _BeforeReminderShow event, not fired. Any idea on what I am missing ?
Imports System.Windows.Forms
Imports System.Windows.Interop
Imports Microsoft.Office.Interop.Outlook
Imports Microsoft.Office.Tools
Imports System.IO
Imports System.Text
Public Class ThisAddIn
Private WithEvents ObjReminders As Reminders
Private Sub ObjReminders_BeforeReminderShow(Cancel As Boolean)
For Each objRem In ObjReminders
If objRem.Caption = "testing" Then
If objRem.IsVisible Then
objRem.Dismiss
Cancel = True
End If
Exit For
End If
Next objRem
End Sub
I also tried the version below after eugene's reply but it also does not reach to BeforeReminderShow event.
Public Class ThisAddIn
Private WithEvents OlRemind As Microsoft.Office.Interop.Outlook.Reminders
Private Sub OlRemind_BeforeReminderShow(Cancel As Boolean)
OlRemind = Application.Reminders
For Each objRem In OlRemind
If objRem.Caption = "testing" Then
If objRem.IsVisible Then
objRem.Dismiss
Cancel = True
End If
Exit For
End If
Next objRem
End Sub
You need to initialize the source object, declaring the reminder object is not enough. So, anywhere in the code you could run the following command:
Set ObjReminders = Application.Reminders
Your code could look in the following way:
' declare this object withEvents throwing all the events
Private WithEvents olRemind As Outlook.Reminders
' run somewhere to initialize the source object
Set olRemind = Application.Reminders
Private Sub olRemind_BeforeReminderShow(Cancel As Boolean)
For Each objRem In olRemind
If objRem.Caption = "TESTING" Then
If objRem.IsVisible Then
objRem.Dismiss
Cancel = True
End If
Exit For
End If
Next objRem
End Sub
You still need to initialize the olRemind object when your addin starts up and you need to either add Handles olRemind.BeforeReminderShow or use AddHandler.
See https://learn.microsoft.com/en-us/dotnet/visual-basic/programming-guide/language-features/procedures/how-to-call-an-event-handler

ItemAdd runs a few times then stops working until I restart Outlook

I want to run a code every time a new email arrives in the inbox.
The following code is within 'ThisOutlookSession'
Public WithEvents oItems as Outlook.Items
Private Sub Application.Startup()
Set oItems = session.GetDefaultFolder(olFolderInbox).items
End sub
Private sub oItems_ItemAdd(ByVal item as object)
Debug.print "New email detected"
End sub
This code runs for 1 - 5 new emails. After that, it won't execute unless I close Outlook and reopen.
It is as if oItems loses connection to the 'session'.
You can paste this in ThisOutlookSession
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim oNewMailItem As Outlook.MailItem
Dim appNameSpace As Outlook.NameSpace
Set appNameSpace = Application.Session
Select Case appNameSpace.GetItemFromID(EntryIDCollection).Class
Case Is = olMail
Set oNewMailItem = appNameSpace.GetItemFromID(EntryIDCollection)
End Select
End Sub
The event returns the object ID, the object ID is used to get the object. If the object is an email then it is saved as a local variable.
Alternatively, you may not want to 'muddy up' ThisOutlookSession so you can use a custom class and expose the mail as a public property.
In ThisOutlookSession you'd have:
Public cNewMailEx As clsNewMailEx
Private Sub Application.Startup()
Set cNewMailEx = New clsNewMailEx
End sub
In a class module named clsNewMailEx you'd have:
Option Explicit
Private WithEvents olApp As Outlook.Application
Private pMailItem As Outlook.MailItem
Public Property Get NewMailItem() As Outlook.MailItem
Set NewMailItem = pMailItem
End Property
Private Sub Class_Initialize()
Set olApp = Outlook.Application
End Sub
Private Sub olApp_NewMailEx(ByVal EntryIDCollection As String)
Dim appNameSpace As Outlook.NameSpace
Set appNameSpace = Application.Session
Select Case appNameSpace.GetItemFromID(EntryIDCollection).Class
Case Is = olMail
Set pMailItem = appNameSpace.GetItemFromID(EntryIDCollection)
End Select
End Sub
Now, anywhere in your application, you can retrieve the new email with cNewMailEx.NewMailItem
NewMailEx is the preferred alternative for the inbox.
For other folders, you could run Application_Startup without closing Outlook.
Remove Private from Private Sub Application_Startup().
1 - You may assign Application_Startup to a button.
2 - To make manual invoking less frequent call Application_Startup from existing code you normally run during the day.

Creating event for Word

Here is a link to, how to create event in Microsoft Word.
https://learn.microsoft.com/en-us/office/vba/word/concepts/objects-properties-methods/using-events-with-the-application-object-word
I created my own class module, and my own code in procedure.
When I try Set X.App = Word.Application
I get
Run-time error '424' Object required
X is declared in dim before App is declared in class module.
In your class module code write this:
Option Explicit
Public WithEvents App As Application
Private Sub App_DocumentChange()
MsgBox "App_DocumentChange - active document has been changed."
End Sub
Private Sub Class_Initialize()
MsgBox "Class Initialize"
End Sub
Name this class module as EventClassModule
In your Module1 code write:
Dim X As New EventClassModule
Sub Register_Event_Handler()
Set X.App = Application
End Sub
Now, if you run sub Register_Event_Handler you should see messagebox "Class Initialize". Note that App_DocumentChange event occurs when you change active document for other, not when you change the content of active document.

VBA Outlook 2010: Monitor new emails in public fodler

whenever a new mail arrives in a public folder, I would like a MsgBox to pop up. I solved this for my own inbox using this code:
Private Sub Application_NewMail()
Dim oNS As NameSpace
Dim oFolder As MAPIFolder
Dim oNewMail As MailItem
Set oNS = Application.GetNamespace("MAPI")
Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
Set oNewMail = oFolder.Items.GetFirst
MsgBox oNewMail.subject
End Sub
I also managed to access and retrieve the latest email from the public folder by replacing:
Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
by
Set oFolder = oNS.Folders(2).Folders(2).Folders("XX").Folders("XX")
Howver, this obviously only works, when I manually evalute the code since the code is only executed when a new mail arrives in my inbox. I did some googling and found a potential solution to monitor a public folder:
Private WithEvents TestMail As Items
Public Sub Application_Startup()
Set TestMail = Application.GetNamespace("MAPI").Folders(2).Folders(2).Folders("XX").Folders("XX").Items
End Sub
Private Sub TestMail_ItemAdd(ByVal Item As Object)
MsgBox ("new mails arrived")
End Sub
Edit - The error when compiling: Unknown attribute in sub or function. I am using Outlook 2010 professional.
Try to use the following code:
Private WithEvents NewMail As Items
Public Sub Application_Startup()
Set NewMail = Application.GetNamespace("MAPI").Folders(2).Folders(2).Folders("XX").Folders("XX").Items
End Sub
Private Sub NewMail_ItemAdd(ByVal Item As Object)
MsgBox ("new mails arrived")
End Sub
However, I'd recommend breaking the long chain of calls:
Set NewMail = Application.GetNamespace("MAPI").Folders(2).Folders(2).Folders("XX").Folders("XX").Items
and declare each property or method call on a separate line of code. Thus, you will find the exact ptoperty or method call which generates the error.
You may find the How to get reference to Public Folder Store using Outlook Object Model for Outlook 2010? article helpful.

Implementing an interface in ThisOutlookSession is not working in Office 2013

I have an Outlook macro I wrote that will automatically mark items as read when I move them to a folder. (I hate having unread messages in folders other than my Inbox.) I wrote the macro in Outlook 2010, and it's been functioning well for years.
I recently upgraded to Office 2013, and now my macro doesn't work--I'm getting a type mismatch error on this line (see below for the full code):
Set oMoveHandler.Callback = Me
oMoveHandler.Callback expects an object of type IMessageMoved, which the object implements, so I'm not sure why I'm getting this error. Any ideas?
ThisOutlookSession code:
Option Explicit
Implements IMessageMoved
Private m_oFolderCollection As Collection
Private Sub Application_Quit()
Set m_oFolderCollection = Nothing
End Sub
Private Sub Application_Startup()
Dim oFolder As Outlook.Folder
Set m_oFolderCollection = New Collection
For Each oFolder In Application.GetNamespace("MAPI").Folders
Call AddFolder(oFolder)
Next oFolder
End Sub
Private Sub AddFolder(Folder As Outlook.Folder)
Dim oFolder As Outlook.Folder
Dim oMoveHandler As MoveHandler
If Folder Is Nothing Then
Exit Sub
End If
If Folder.Folders.Count = 0 Then
Exit Sub
End If
For Each oFolder In Folder.Folders
If oFolder.DefaultItemType = olMailItem Then
If oFolder.Name <> "Inbox" And oFolder.Name <> "Outbox" And oFolder.Name <> "ePrescribing Workgroup" Then
Set oMoveHandler = New MoveHandler
Set oMoveHandler.Folder = oFolder.Items
Set oMoveHandler.Callback = Me
Call m_oFolderCollection.Add(oMoveHandler)
Set oMoveHandler = Nothing
End If
Call AddFolder(oFolder)
End If
Next oFolder
End Sub
Private Function IMessageMoved_MessageMoved(Item As Object) As Variant
On Error Resume Next
Item.UnRead = False
On Error GoTo 0
End Function
IMessageMoved:
Public Function MessageMoved(Item As Object)
End Function
MoveHandler:
Private WithEvents m_oFolder As Outlook.Items
Private m_oCallback As IMessageMoved
Public Property Set Folder(Folder As Outlook.Items)
Set m_oFolder = Folder
End Property
Public Property Get Folder() As Outlook.Items
Set Folder = m_oFolder
End Property
Public Property Set Callback(Object As IMessageMoved)
Set m_oCallback = Object
End Property
Private Sub Class_Terminate()
Set m_oFolder = Nothing
Set m_oCallback = Nothing
End Sub
Private Sub m_oFolder_ItemAdd(ByVal Item As Object)
If Not m_oCallback Is Nothing Then
Call m_oCallback.MessageMoved(Item)
End If
End Sub
I suspect I was actually running into a similar issue to the one described in this post describing a similar problem in Excel where binding just wasn't working as expected. To work around it, I ended up moving my interface out of ThisOutlookSession into a separate class which I then just instantiate from ThisOutlookSession.