Create Outlook rule action to mark message header for download

I just don't have the time to look into this like I normally would to "learn" the solution on my own. I hope you experts can help and glad to have a question for you. :)

I use Outlook 2007 on a computer. I have it set to only download headers and then I mark the messages I wanted to download or click to delete the others. I would like to make this a little smarter by setting up a rule. My thought was to set the rule to automatically mark messages from those in my Contacts list/address book. It would be great to have the message body downloaded too so I don't have to wait for the next Send/Receive to process the "download" request.

I found the rules area and think it is just the Action part I need help on. Since Outlook doesn't have a built in choice for this I looked at Custom Actions but that seems much harder. I was hoping for a script that could do this (i.e. a macro).

I hope to have this run when it checks for messages. Will Outlook run this on a message that only has the header downloaded? If not then I am out of luck.

Solution: Create Outlook rule action to mark message header for download

Hey!

Ok, give this a try. The code has to go in the ThisOutlookSession module and you'll need to close and restart Outlook after adding it. You also need to edit the line below the in-code comment. You'll probably want to use the code debugger to find the position number of the selection you want.

This works by monitoring the inbox folder for new items. When one arrives the code checks to see if it's a header. If it is a header item, then the code searches contacts for an item with a matching email address. If it finds one, then it marks the header for download and initiates a send/receive. I gave it a quick test (one item) and it worked fine.

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:

           
           
             Private WithEvents olkInbox As Outlook.Items
 
Private Sub Application_MAPILogonComplete()
    Set olkInbox = Session.GetDefaultFolder(olFolderInbox).Items
End Sub
 
Private Sub Application_Quit()
    Set olkInbox = Nothing
End Sub
 
Private Sub olkInbox_ItemAdd(ByVal Item As Object)
    Dim olkHeader As Outlook.RemoteItem, _
        olkProp As Outlook.PropertyAccessor, _
        olkContacts As Outlook.Items, _
        olkContact As Outlook.ContactItem, _
        olkCmdBar As Office.CommandBar, _
        olkCmdBarPop As Office.CommandBarPopup, _
        olkCmdBarBtn As Office.CommandBarButton, _
        olkExplorer As Outlook.Explorer, _
        strAddress As String
    If Item.Class = olRemote Then
        Set olkContacts = Session.GetDefaultFolder(olFolderContacts).Items
        Set olkHeader = Item
        Set olkProp = olkHeader.PropertyAccessor
        strAddress = olkProp.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0C1F001E")
        On Error Resume Next
        Set olkContact = olkContacts.Find("[Email1Address] = '" & strAddress & "' OR [Email2Address] = '" & strAddress & "' OR [Email3Address] = '" & strAddress & "'")
        If TypeName(olkContact) = "ContactItem" Then
            olkHeader.MarkForDownload = olMarkedForDownload
            olkHeader.Save
            Set olkExplorer = Application.ActiveExplorer
            Set olkCmdBar = olkExplorer.CommandBars("Retrieve Mail From")
            'Replace 8 on the following line with the position number of the selection you want to make'
            Set olkCmdBarPop = olkCmdBar.Controls.Item(8)
            Set olkCmdBarBtn = olkCmdBarPop.Controls(3)
            olkCmdBarBtn.Execute
        End If
        On Error GoTo 0
    End If
    Set olkHeader = Nothing
    Set olkProp = Nothing
    Set olkContacts = Nothing
    Set olkContact = Nothing
    Set olkCmdBar = Nothing
    Set olkCmdBarPop = Nothing
    Set olkCmdBarBtn = Nothing
    Set olkExplorer = Nothing
End Sub
           
         

Open in New Window

Select All