How do I run a macro automatically on send/receice (Outlook)

Question

Hi,

I've coded a macro which loops through the emails in my Outlook inbox. If the mail is unread, is sent from a specific address and contains a specific attachment, then the attachment is copied to a folder on my hard drive.

This all works fine and dandy, but I would like the macro to run automatically as new emails are received. Either directly after all new emails are received or as each new email arrives (essentially like a rule then I guess). How do I do this?

Answer 1

Hi, you need to add your code to the NewMailEx event in ThisOutLookSession.

Regards

ADG

Answer 2

Thanks for the reply, I've managed to get it partially working.

After doing some reading on the NewMailEx event I arrived at the following (abbreviated) code:

Private Sub Application_NewMailEx()


For Each msg In InboxFolder

    If msg.UnRead = True Then

         Do Stuff

    End If

Next


End Sub

The problem is that this code only works if I remove the "If msg.Unread = True Then" statement. If I leave it in there, the macro doesn't appear to run at all. However, if I run the macro (with the if statement) manually it does as intended. This if statement ensures that previous files that have been copied from the emails are not copied again.

What's the problem here?

And on a side note...

If I understand the NewMailEx event correctly, it would probably be better to use the Entry ID collection string generated by the NewMailEx to identify the new emails and then take it from there. I did try to incorporate the code I found here: http://msdn.microsoft.com/en-us/library/aa171304(office.11).aspx into my existing program but was unable to get it working. Also, it seems rather messy having to sort through the string like this.

Answer 3

Hi,

Entry ID collection is what you need it gets the incoming mail (always unread),, as you say it is messy. The below code runs in my home inbox and forwards mail to one of two e-mail addresses that I use for work (email addresses have been over written with x  for security). The code loops through the string then catches the end of the string after the loop so you enter some code twice. I also based the below on the help example

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim mai As Object
Dim intInitial As Integer
Dim intFinal As Integer
Dim strEntryId As String
Dim intLength As Integer
Dim MyItem As Outlook.MailItem
   
    intInitial = 1
    intLength = Len(EntryIDCollection)
    intFinal = InStr(intInitial, EntryIDCollection, ",")
    Do While intFinal <> 0
        strEntryId = Strings.Mid(EntryIDCollection, intInitial, (intFinal - intInitial))
        Set mai = Application.Session.GetItemFromID(strEntryId)
        If InStr(1, mai.SenderEmailAddress, "cihgroup.com") > 0 Then
            MsgBox mai.Subject
            Set MyItem = mai.Forward
            MyItem.Recipients.Add "EMAIL GONE"
                     MyItem.Send
        Else
            If InStr(1, mai.SenderEmailAddress, "cedo") = 0 Then
                Set MyItem = mai.Forward
                MyItem.Recipients.Add "EMAIL GONE"
                MyItem.Send
            End If
        End If
       
        intInitial = intFinal + 1
        intFinal = InStr(intInitial, EntryIDCollection, ",")
    Loop
    strEntryId = Strings.Mid(EntryIDCollection, intInitial, (intLength - intInitial) + 1)
   
    Set mai = Application.Session.GetItemFromID(strEntryId)
    If InStr(1, mai.SenderEmailAddress, "cihgroup.com") > 0 Then
            Set MyItem = mai.Forward
            MyItem.Recipients.Add "EMAIL GONE"
             MyItem.Send
    Else
        If InStr(1, mai.SenderEmailAddress, "cedo") = 0 Then
            Set MyItem = mai.Forward
            MyItem.Recipients.Add "EMAIL GONE"
            MyItem.Send
        End If
    End If
End Sub

Answer 4

Cool thanks. I've mangled your code in with mine :P Unfortunately it doesn't run. The event is triggered (i know this as it threw an error the first time because I forgot to remove an "end if") but it doesn't do anything. I removed the "mai" object and have a "msg As Outlook.MailItem" in it's place. I'm guessing the problem lies therein. Here is my code (with the extra cases removed to make it easier to read):

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)

Dim intInitial As Integer
Dim intFinal As Integer
Dim strEntryId As String
Dim intLength As Integer

    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim SubFolder As MAPIFolder
    Dim Atchmt As Attachment
    Dim FileName As String
    Dim msg As Outlook.MailItem

    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set SubFolder = Inbox.Folders("Books")
  
    intInitial = 1
    intLength = Len(EntryIDCollection)
    intFinal = InStr(intInitial, EntryIDCollection, ",")
    Do While intFinal <> 0
        strEntryId = Strings.Mid(EntryIDCollection, intInitial, (intFinal - intInitial))
        Set msg = Application.Session.GetItemFromID(strEntryId)
   
        For Each msg In SubFolder.Items
            If LCase(msg.Subject) Like "*books*" Then
                For Each Atchmt In msg.Attachments
                    If (Right(Atchmt.FileName, 3) = "xls") Then
                        Select Case msg.SenderEmailAddress
                       
                            Case "email address"
                                FileName = "D:\Books\Test\" & Atchmt.FileName
                                Atchmt.SaveAsFile FileName

                        End Select
                    End If
                Next
            End If
        Next
      
        intInitial = intFinal + 1
        intFinal = InStr(intInitial, EntryIDCollection, ",")
    Loop
   
    strEntryId = Strings.Mid(EntryIDCollection, intInitial, (intLength - intInitial) + 1)
    Set msg = Application.Session.GetItemFromID(strEntryId)
   
    For Each msg In SubFolder.Items
        If LCase(msg.Subject) Like "*books*" Then
            For Each Atchmt In msg.Attachments
                If (Right(Atchmt.FileName, 3) = "xls") Then
                    Select Case msg.SenderEmailAddress

                        Case "email address"
                            FileName = "D:\Books\Test\" & Atchmt.FileName
                            Atchmt.SaveAsFile FileName

                    End Select
                End If
            Next
        End If
    Next
      
GetAttachments_exit:
    Set msg = Nothing
    Set Atchmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub

End Sub

Answer 5

Hi, your problem lies in that the event is designed to look through the new incoming mails in the mail box, the line Set msg = Application.Session.GetItemFromID(strEntryId) gets the message on arrival. But your code does not work with this mail item but scrolls through your subfolder, because your next line is For Each msg In SubFolder.Items which changes the mail message item. If you want to checkout the subfolder using the new mail event as a trigger lose the code working through the EntryCollectionID. If you want to look at the incoming mail only lose the for each msg in Subfolder.Items.
 

Answer 6

Right, that makes sense. How would I then get the EntryID's of the new messages that exist in the subfolder only?

Answer 7

Hi, if the mail item arrives in the subfolder  because of a rule I am not sure if the event is triggered before our after the item is moved. But you can tell where the mail item is by using msg.Parent which should return the folder name.

 

Regards

 

ADG

Answer 8

Yip, that's correct. I have 3 different email addresses. Each one has a corresponding folder with a rule to sort the mail into each one.

I would like to either accept only the EntryID's from the subfolder "Books" or sift through them to find the ones that arrived in the "Books" subfolder, once all the EntryID's have been received.

I've tried the following 3 statements but none of them do anything. These are in place of the "For Each msg In SubFolder.Items" above.


If msg.Parent = SubFolder.Name Then

For Each msg In SubFolder

If strEntryId = SubFolder.EntryID Then


How would I type: If msg exists in Subfolder then

Answer 9

Anyone?