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.
Related
I have a macro that, upon the closing of the Outlook client, a private variable is set to an instance of a class module.
The code runs and no errors are thrown. However, the class module that is passed (correct me if I am using the wrong terminology), does not have its subroutine run.
The goal is to create and save a new note item upon application exit.
From "ThisOutlookSession" (Microsoft Outlook Object):
Option Explicit
Private ShutdownTrigger As Class2
Private Sub Application_Quit()
Set ShutdownTrigger = New Class2
End Sub
From "Class2" (Class Module):
Option Explicit
Private Sub ExitApp()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olNoteItm As Outlook.NoteItem
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olNoteItm = olApp.CreateItem(olNoteItem)
With olNoteItm
.Body = "murphy"
End With
olNoteItm.Save
End Sub
The note is not being created. Note, the subroutine "ExitApp" code works when placed within the "ThisOutlookSession" object, however.
Also, as an potentially unrelated question, do I need to create a private variable "Shutdown Trigger", or can I use a Dim statement as I do in most subroutines?
First of all, there is no need to create a new Outlook Application instance in the code to create a new note item Outlook. Instead, you could get an Application instance in the ThisOutlookSession module and pass it to the method.
Second, you need to call the ExitApp method on the object created:
Option Explicit
Private ShutdownTrigger As Class2
Private Sub Application_Quit()
Set ShutdownTrigger = New Class2
ShutdownTrigger.ExitApp()
End Sub
Third, the method may look in the following way:
Option Explicit
Private Sub ExitApp(olApp As Outlook.Application)
Dim olNS As Outlook.NameSpace
Dim olNoteItm As Outlook.NoteItem
Set olNS = olApp.GetNamespace("MAPI")
Set olNoteItm = olApp.CreateItem(olNoteItem)
With olNoteItm
.Body = "murphy"
End With
olNoteItm.Save
End Sub
Read more about class modules in VBA in the VBA Class Modules – The Ultimate Guide article.
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.
I'm getting this error:
only valid in object module
when I'm trying to run the script below on VBA outlook 2016.
Private WithEvents myItem As outlook.MailItem
Private Sub myItem_AttachmentRead(ByVal myAttachment As Outlook.Attachment)
If myAttachment.Type = olByValue Then
MsgBox "If you change this file, also save your changes to the original file."
End If
End Sub
Public Sub TestAttachRead()
Dim atts As Outlook.Attachments
Dim myAttachment As Outlook.Attachment
Set myItem = Application.ActiveExplorer.CurrentFolder.Items("Test")
Set atts = myItem.Attachments
myItem.Display
End Sub
The following vba code Must be under ThisOutlookSession module
Private WithEvents myItem As outlook.MailItem
Private Sub myItem_AttachmentRead(ByVal myAttachment As Outlook.Attachment)
If myAttachment.Type = olByValue Then
MsgBox "If you change this file, also save your changes to the original file."
End If
End Sub
And the following vba code could be on regular module
Public Sub TestAttachRead()
Dim atts As Outlook.Attachments
Dim myAttachment As Outlook.Attachment
Set myItem = Application.ActiveExplorer.CurrentFolder.Items("Test")
Set atts = myItem.Attachments
myItem.Display
End Sub
I'm presuming this code is currently on a standard VBA module. You cannot have an WithEvents variable on such modules. It must be either a class module or a document module (e.g. one of Outlook's code-behind for instance) in order to receive events from that mail item.
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.
I'm receiving Error 429 'Active X Component Can't create the object' when I start Outlook 2013. While debugging I found it was occurring at Set oOutlook = New Outlook.Application. But when I run the code after Outlook is started it works fine. Any idea why this is occurring?
Option Explicit
Private WithEvents oOutlook As Outlook.Application
Private WithEvents oMailItems As Outlook.Items
Private ns As NameSpace
Private Inbox As MAPIFolder
Private InboxItems As Outlook.Items
Private FailNotice As MAPIFolder
Private zsForwardTo As String
Private Sub Class_Initialize()
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set InboxItems = Inbox.Items
Set oOutlook = New Outlook.Application
Set oMailItems = oOutlook.Session.GetDefaultFolder(olFolderInbox).Items
Set FailNotice = Inbox.Folders("Fail Notices")
End Sub
Based on Max's comment, I wanted to post an answer because this was really helpful and I couldn't find this anywhere else on the web. Max wrote:
I had a simular problem, I think Outlook is having a problem wirh creating a new instance while it is not fully started itself. In the end i did not create a new application but worked in the existing one.
I wasn't sure how to use the existing application, but I got it working like this: the oOutlook variable is now unnecessary and can be replaced by the simple word "Application". The revised code would look like this:
Option Explicit
Private WithEvents oMailItems As Outlook.Items
Private ns As NameSpace
Private Inbox As MAPIFolder
Private InboxItems As Outlook.Items
Private FailNotice As MAPIFolder
Private zsForwardTo As String
Private Sub Class_Initialize()
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set InboxItems = Inbox.Items
Set oMailItems = Application.Session.GetDefaultFolder(olFolderInbox).Items
Set FailNotice = Inbox.Folders("Fail Notices")
End Sub