Excel Hints

Results 1 to 5 of 5

Thread: Iterating through a set of MailItems

  1. #1

    Iterating through a set of MailItems

    I have some code that grabs a set of emails from a folder like such:

    [vba] Set OutApp = CreateObject("Outlook.Application")
    Set OutNS = OutApp.GetNameSpace("MAPI")
    Set OutRecipient = OutNS.CreateRecipient(ABC_MailboxName)
    Set OutFolder = OutNS.GetSharedDefaultFolder(OutRecipient, 6) 'olFolderInbox = 6

    Set OutItems = OutFolder.Items[/vba]
    I then iterate through the messages: if a MailItem has an attachment with the correct name, the attachment is saved to a temp folder.


    My question is: is my set of MailItems static or dynamic?

    In other words, what happens if a new email is sent to this folder (separately, either by an open instance of Outlook or the Exchange server)? Is my set of items updated to include the new email, or is it static from the point when I put the Object handle on the Folder.Items?



    Second question: Deleting those emails

    Once I've saved all the attachments, then I have a loop to go back and delete all of the emails. However, this code doesn't work! It always seems to leave ONE email in the box, which suggests that I'm missing something about how the MailItem collections work.

    [vba]
    For Each OutMail In OutItems

    Set OutAttachments = OutMail.Attachments

    For Each OutAttach In OutAttachments

    If OutAttach.Filename = constABCInputFName Then
    OutMail.Delete
    End If

    Next OutAttach

    Next OutMail[/vba]

  2. #2
    Quote Originally Posted by Dr.K
    My question is: is my set of MailItems static or dynamic?
    I'm guessing here, but I think it's dynamic. You could try dropping an email into the folder and see what happens to OutItems.Count.

    Once I've saved all the attachments, then I have a loop to go back and delete all of the emails. However, this code doesn't work! It always seems to leave ONE email in the box, which suggests that I'm missing something about how the MailItem collections work.
    If you are deleting, you need to loop backwards. Use a For Loop instead of a For Each Loop. You may also want to apply the Restrict Method on your loop (limiting the collection to items with attachments) to make it faster.
    Regards,
    JP

    Read the FAQ
    Getting free help on the web
    My website
    Please use [vba][/vba] tags when posting code

  3. #3
    Quote Originally Posted by JP2112
    If you are deleting, you need to loop backwards. Use a For Loop instead of a For Each Loop.
    Um... What? You mean For/Next loop? I don't understand.

    Thanks for the Restrict Method, though, that looks VERY useful.

  4. #4
    Let's do both.

    First, you'll need to create a subset of your items, using the Restrict Method.

    [vba]Set OutItems = OutItems.Restrict("[Attachment] > 0")[/vba]
    This will filter the existing collection, creating a subset of items that have attachments.

    Then we iterate backwards through the collection, since we need to delete. This is where the For Loop comes in.

    [vba]Dim i As Long

    For i = OutItems.Count To 1 Step -1
    ' set an object reference to current message
    Set OutMail = OutItems.Item(i)
    Set OutAttachments = OutMail.Attachments

    For Each OutAttach In OutAttachments
    If OutAttach.Filename = constABCInputFName Then
    OutMail.Delete
    End If
    Next OutAttach
    Next i[/vba]
    Regards,
    JP

    Read the FAQ
    Getting free help on the web
    My website
    Please use [vba][/vba] tags when posting code

  5. #5
    Apparently, working with Items Collections in Outlook is a tricky thing... not only are the Collections dynamic, but there are both static and dynamic Object handles that can be attached to them!

    Great wisdom on the topic found here:
    http://msdn.microsoft.com/en-us/libr...ice.10%29.aspx

    The Restrict Method was not as useful as I had hoped. What I would really have liked to do is to filter to all MailItems in a Collection that had an Attachment with a specific name. Something like:

    [vba]Set OutItems = OutItems.Restrict("[Attachment.FileName] = """ & strVariable & """") [/vba]
    However, it appears the Attachment Properties are not available to the Restrict method. If they are, I couldn't figure out the syntax.

    Here is (most) of my final code. This Sub iterates through an Inbox, creating a record of each MailItem in an array, and saving the Workbook Attachments to a temp directory. Then, the data in each Workbook is uploaded to an Access DB with SQL injection.

    Finally, the original emails are deleted. Instead of iterating through and looking for the Attachment again, emails are identified by their EntryID property, so that each email can be directly deleted.

    [vba]

    '**Set up Outlook objects
    Set OutApp = CreateObject("Outlook.Application")
    Set OutNS = OutApp.GetNameSpace("MAPI")
    Set OutRecipient = OutNS.CreateRecipient(constMailBoxName)
    Set OutFolder = OutNS.GetSharedDefaultFolder(OutRecipient, 6) 'olFolderInbox = 6
    Set OutItems = OutFolder.Items

    'restrict and sort items
    Set OutItems = OutItems.Restrict("[MessageClass] = 'IPM.Note'")
    OutItems.Sort "[Received]", False


    '**iterate through mailitems in inbox to find Mail Item with correct attachment,
    'copy to temp directory (in order)
    lngCount = 0

    'get first item
    Set OutMail = OutItems.GetFirst

    'begin loop
    Do While TypeName(OutMail) <> "Nothing"

    Set OutAttachments = OutMail.Attachments

    For Each OutAttach In OutAttachments

    If OutAttach.Filename = constInputFName Then

    'increase count
    lngCount = lngCount + 1

    'Store Entry ID and Recieved date/time
    ReDim Preserve arrEmails(1 To 3, 1 To lngCount)
    arrEmails(1, lngCount) = OutMail.entryid
    arrEmails(2, lngCount) = CDate(OutMail.receivedtime)

    'Save file to tempdir with new name
    strFName = constABCInputFNameStub & lngCount & ".xls"
    arrEmails(3, lngCount) = strFName
    OutAttach.SaveAsFile strTempDir & "\" & strFName

    End If

    Next OutAttach

    'switch to next item
    Set OutMail = OutItems.Getnext

    Loop



    '**Import data to database

    'branch on quantity: excape out if less then 1 file to process
    If lngCount < 1 Then GoTo EscapeHatch

    'open DB connection
    OpenAccConn



    'Loop through workbooks
    For x = 1 To lngCount


    'Workbook handling routine REMOVED:
    'opens workbook as readonly
    'Creates new Records in DataBase
    'closes workbook


    '**Delete the original email

    'Refresh object handles
    Set OutItems = OutFolder.Items
    Set OutItems = OutItems.Restrict("[MessageClass] = 'IPM.Note'")
    Set OutMail = OutItems.GetFirst

    'begin loop
    Do

    If OutMail.entryid = arrEmails(1, x) Then
    OutMail.Delete
    Exit Do
    Else
    Set OutMail = OutItems.Getnext
    End If

    Loop

    Next x


    EscapeHatch:

    'Clean up all variables and Objects[/vba]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •