Trapping Outlook .ItemAdd Event on Sent Folder, From Access

Question

I'm working within MS Access 2013 and MS Outlook 2013 on Windows 10 and I have a Access DB with a "Navigation Subforms" paradigm that allows sending a single e-mail on two separate occasions.

I'm trying to write code to do the following:

when a new e-mail is sent,
I want to save it as a .msg file on disk automatically.

From what I can tell, it seems the way to do this is via trapping the .ItemAdd event that fires on Outlook Sent Folder within Access, and in there executing the .SaveAs method.

I was trying to implement a solution based on these two answers:

How to Trap Outlook Events from Excel Application

Utilizing Outlook Events From Excel

but I just can't seem to combine the two and make the event fire.

My feeling is that either I'm not referencing/setting things correctly or the execution reaches an end before the e-mail is moved from the Outbox Folder to the Sent Folder, but I'm not sure.

How can I do this?

Thanks for reading, code follows:

My current class module - "cSentFolderItem"

Option Explicit

Public WithEvents myOlItems As Outlook.items

Private Sub Class_Initialize()

    Dim oNS As NameSpace
    Dim myOL As Outlook.Application

    Set myOL = New Outlook.Application
    Set oNS = myOL.GetNamespace("MAPI")
    Set myOlItems = oNS.GetDefaultFolder(olFolderSentMail).items

End Sub


Private Sub myOlItems_ItemAdd(ByVal Item As Object)
    Debug.Print "I got a new item on Sent box!"
    Dim myOlMItem As Outlook.MailItem

    Set myItem = myOlItems.items(email_subject)
    myItem.Display

    myItem.SaveAs "C:\Users\XXXXXX\Desktop\mail_test.msg", olMSGUnicode

End Sub

"Regular" code:

Public 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


Sub Test()
    email_subject = "Mail test match string - [aaaa-mm-dd]"

    Set myOlItems = New cSentFolderItem 'declare class module object

    Dim MyOutlook As Outlook.Application
    Set MyOutlook = GetApplication("Outlook.Application") 'trying to get correct application object

    'The following code is a dummy e-mail creation, after which I press SEND:
    Dim MyMail As Outlook.MailItem

    varTo = "target_email@address.com"
    varSubject = email_subject
    varbody = "test line 1" & vbCrLf & "test line 2" & vbCrLf & "test line 2"

    varSubject = Replace(varSubject, "[aaaa-mm-dd]", NOW())

    Dim linhas() As String
    linhas = Split(varbody, vbCrLf)

    bodyHTMLtext = "<body>"
    For i = 0 To UBound(linhas) - 1
        bodyHTMLtext = bodyHTMLtext & linhas(i) & "<br>"
    Next

    bodyHTMLtext = bodyHTMLtext & linhas(UBound(linhas))
    bodyHTMLtext = bodyHTMLtext & "</body>"

    Set MyMail = MyOutlook.CreateItem(OLMAILITEM)

    MyMail.To = varTo
    MyMail.Subject = varSubject

    MyMail.Display

    MyMail.HTMLBody = bodyHTMLtext & MyMail.HTMLBody

    AppActivate varSubject

    'trying to leave Outlook object open:
    ''Cleanup after ourselves
    'Set MyMail = Nothing

    ''MyOutlook.Quit
    'Set MyOutlook = Nothing        

End Sub

So what is the problem? Does you code run? Have you tried to step through it? — Dmitry Streblechenko, Feb 15 '17 at 00:23
In your myOlItems_ItemAdd event handle, why do you retrieve the message by its subject instead of using the item passed to you as a parameter? — Dmitry Streblechenko, Feb 15 '17 at 00:24
@DmitryStreblechenko: thanks for commenting. As I mentioned in my solution, I retrieve the message by subject because I'm not interested in all new sent e-mails, but rather some specific ones, which I track via their subject. — Cinetyk, Feb 15 '17 at 11:40
Ok, so when ItemAdd event fires, check that Item's subject. Why do yo need to search through all items in the folder? — Dmitry Streblechenko, Feb 15 '17 at 13:36

Cinetyk · Accepted Answer · 2017-02-15T14:48:33.887

Ok, after some long hours, I figured it out, and got to the following solution.

My class module "MyOutlook" is:

Option Explicit

Public myOutlookApp As Outlook.Application
Public mySentFolder As Outlook.Folder
Public WithEvents myItems As Outlook.items

Private Sub Class_Initialize()

    Set myOutlookApp = GetApplication("Outlook.Application")

    Dim oNS As NameSpace
    Set oNS = myOutlookApp.GetNamespace("MAPI")
    Set mySentFolder = oNS.GetDefaultFolder(olFolderSentMail)
    Set myItems = mySentFolder.items

End Sub

Private Sub myItems_ItemAdd(ByVal Item As Object)

    Debug.Print "Got_EMAIL!!! Looking for subject = " & email_subject
    '"e-mail_subject" is Public a string, assigned in another part of the program

    If Item.Subject = email_subject Then 
        Item.SaveAs "C:\Users\640344\Desktop\mail_test.msg", olMSGUnicode
    End If

End Sub

Where GetApplication is:

Function GetApplication(Class As String) As Object
    'Handles creating/getting the instance of an application class
    'If there exists one already (in my case, Outlook already open),
    'it gets its name, else it creates one

    Dim ret As Object

    On Error Resume Next

    Set ret = GetObject(, Class)
    If Err.Number <> 0 Then
        Set ret = CreateObject(Class)
        If Class = "Outlook.Application" Then
            'Outlook wasn't opened, so open it
            ret.Session.GetDefaultFolder(olFolderInbox).Display
            ret.ActiveExplorer.WindowState = olMaximized
            ret.ActiveExplorer.WindowState = olMinimized
        End If
    End If

    Set GetApplication = ret

    On Error GoTo 0

End Function

Note that I added the 3 lines of code after 'Outlook wasn't opened, so open it because otherwise I would get an error. It's not a bad idea for my users that the program opens Outlook, anyway.

On the "regular" code part of my project, outside any procedure, I declare:

Public myOutlook As myOutlook

Then, on my project's "main" sub:

Set myOutlook = New myOutlook
'[...]
'Code where entire program runs
'[...]
Set myOutlook = Nothing

This way, myOutlook object (and its variables) "lives" the entire time the program (with its Navigation Forms) is running, and is waiting to trap _ItemAdd events on the default Sent Folder of Outlook.

Note that I look only for e-mails with subject equal to the email_subject string, because I don't want to save all sent e-mails, just the one sent by using the program, and I have code to assign my desired subject to that string.

"myOutlookApp" and "mySentFolder" can be declared as Private if there's no need to reference them from the outside. — Cinetyk, Feb 16 '17 at 11:42

Trapping Outlook .ItemAdd Event on Sent Folder, From Access

1 Answers1