Downloading attachments, how to do it   

Ok, it's working. Here's what you do.

To start with, use ADO/ODBC/whatever to do a find and get the message that 
you want. If you want "all attachments" then just skip this step. However, 
you probably don't want "all attachments", because then you'll be 
re-downloading them every time you run it. Anyway...

    ' use ODBC to open the mail folder and get the list of attachments
    conn = ("Provider=Microsoft.Jet.OLEDB.4.0;Exchange 4.0;MAPILEVEL=Public 
Folders|All Public Folders;DATABASE=C:\\temp\\;")
    Set rstEmails = New ADODB.Recordset
    rstEmails.Open "SELECT * FROM mytable WHERE [From] LIKE '%@adomain.com' 
AND [Has Attachments]=True AND [Received]>=#" & date & "# AND [Received]<#" & 
DateAdd("d", 1, date) & "#", conn, adOpenStatic, adLockReadOnly
    if rstEmails.EOF THEN (do something here)

This should be fairly clear: it does a search to find messages that have an 
attachment that posted today from a particular address. We do this so we can 
find the message using the following code.

Ok, now that we have our message, use CDO to actually get at it...

    Set Session = CreateObject("MAPI.session")
    Session.logon "", "", False, False, 0
    Set Folder = Session.infostores("Public 
Folders").rootfolder.folders(2).folders("the folder")

That last line of code is rather nasty. Instead of providing a way to get at 
these folders easily from the root, you have to traverse the entire store in 
the same way that it is displayed in Outlook. Worse, there appears to be no 
way to access "All Public Folders" by name, you have to do it by index, the 
(2), which is fragile to say the least (1 is "Favorites").

Ok, now you have the folder you're interested in, so we loop over the 
messages and see if we can find the one we wanted...

    Set Messages = Folder.Messages
    Set Message = Messages.GetFirst()
    Do While Not Message Is Nothing
        ' skip over ones that don't match
        If Message.Subject <> rstEmails!Subject Then GoTo TRYNEXT
        If Message.Sender <> rstEmails!from Then GoTo TRYNEXT
        If Message.TimeCreated <> rstEmails![Creation Time] Then GoTo TRYNEXT
' ADD ADDITIONAL TESTS HERE, BUT THIS SEEMS TO WORK 100% IN MY CASE

        ' found it, get the attachment
        Debug.Print Message.Subject
        Set Attachment = Message.Attachments(1)
        Attachment.WriteToFile "O:\aPricing\ms_cds_" & Format(date, 
"yyyymmdd") & ".txt.pgp"
        GoTo ALLDONE

TRYNEXT:
        Set Message = Messages.GetNext()
    Loop

ALLDONE:

If you are trying to download every message, or every message from today, 
you can simply use the second part, the CDO portion, and skip the ADO part at 
the top.

I would also like to figure out a way to make the testing for "the right 
message" more accurate. It would be nice if I could get the ID from ADO, but 
it doesn't seem like this is possible. If anyone can think of a better way to 
navigate to the public folder of your choice, I'd love to hear from you.

Enjoy!

Maury

date: Tue, 19 Feb 2008 10:11:01 -0800   author:   Maury Markowitz