Finding most recent email in Outlook

This code is supposed to sort the emails in my Inbox in descending order and grab the most recent email meeting the specified criteria, then save that file.  Instead, the result is the code does not select the most recent email meeting criteria.  In fact, does find an email meeting the criteria but it appears to be randomly selecting the email because I have run the code several times and it seems to pick a different email each time, not necessarily the newest or oldest.  Thanks for the help in advance!

Function AttachmentsMove_DecoStatus_Robinson()
 
Try_Again:
' This Outlook macro checks a the Outlook Inbox for messages
' with attached files (of any type) and saves them to disk.
' NOTE: make sure the specified save folder exists before
' running the macro.
    On Error GoTo GetAttachments_err
' Declare variables
    Dim myolApp As New Outlook.Application
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Outlook.Attachment
    Dim FileName As String
    Dim i As Integer
    Dim Reports As MAPIFolder
    Dim blnFound As Boolean
            
    Set myolApp = CreateObject("Outlook.Application")
    Set ns = myolApp.GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set Reports = ns.Folders("Personal Folders").Folders("Decoration_Status")
    
    i = 0
    
    
' Check Inbox for messages and exit of none found
    If Inbox.Items.Count = 0 Then
        MsgBox "There are no messages in the Inbox.", vbInformation, _
               "Nothing Found"
        Exit Function
    End If
    blnFound = False

' Sort the inbox into received sequence
        Inbox.Items.Sort "[Received]", True

' Check each message for attachments
    For Each Item In Inbox.Items

' Save any attachments found
        For Each Atmt In Item.Attachments
        ' This path must exist! Change folder name as necessary.
            If Atmt.Type <> olOLE Then
                If Atmt.FileName Like "RM BSN Status*" Then
                    blnFound = True
                    Atmt.SaveAsFile "P:\Sales_Field\Decoration\Robinson\" & Atmt.FileName
                    i = i + 1
                End If
            End If
         Next Atmt
         
         If i >= 1 Then
                
         Exit For
         
         End If
         
         
    Next Item
    
    If Not blnFound Then
        MsgBox "Error - Decoration Status Report for Robinson not found in Inbox in Outlook"
        ' if you want the code to stop right here,
        Stop
        ' if you want the code to stop running,
        ' End
        Else
        Item.Move Reports
        
    End If
    

' Clear memory
GetAttachments_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Function
' Handle errors
GetAttachments_err:
    MsgBox "Couldn't get into Outlook or there was an issue retrieving/saving one of the attachments."
        Stop
        GoTo Try_Again:
        '& vbCrLf & "Please note and report the following information." _
        '& vbCrLf & "Macro Name: GetAttachments" _
        '& vbCrLf & "Error Number: " & Err.Number _
        '& vbCrLf & "Error Description: " & Err.Description _
        , vbCritical, "Error!"
    Resume GetAttachments_exit
   
End Function

Open in new window

bsncpAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Nick67Commented:
You have a For each


' Check each message for attachments
    For Each Item In Inbox.Items
... do some stuff

Next Item



But you'll note that you don't have a exit after you do your stuff.
So your loop will continue to process until it reaches the end of the Inbox in all cases.

That's the grief

You exit this one
' Save any attachments found
        For Each Atmt In Item.Attachments
        ' This path must exist! Change folder name as necessary.
            If Atmt.Type <> olOLE Then
                If Atmt.FileName Like "RM BSN Status*" Then
                    blnFound = True
                    Atmt.SaveAsFile "P:\Sales_Field\Decoration\Robinson\" & Atmt.FileName
                    i = i + 1
                End If
            End If
         Next Atmt
         
         If i >= 1 Then
               
         Exit For

after the first attachment.

You need similar follow control on your Items For Each loop
Nick67Commented:
This is close

Function AttachmentsMove_DecoStatus_Robinson()
 
Try_Again:
' This Outlook macro checks a the Outlook Inbox for messages
' with attached files (of any type) and saves them to disk.
' NOTE: make sure the specified save folder exists before
' running the macro.
On Error GoTo GetAttachments_err
' Declare variables
Dim myolApp As New Outlook.Application
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Outlook.Attachment
Dim FileName As String
Dim i As Integer
Dim Reports As MAPIFolder
Dim blnFound As Boolean
        
Set myolApp = CreateObject("Outlook.Application")
Set ns = myolApp.GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set Reports = ns.Folders("Personal Folders").Folders("Decoration_Status")

i = 0


' Check Inbox for messages and exit of none found
If Inbox.Items.Count = 0 Then
    MsgBox "There are no messages in the Inbox.", vbInformation, _
           "Nothing Found"
    Exit Function 'bail
End If
blnFound = False

' Sort the inbox into received sequence
Inbox.Items.Sort "[Received]", True

' Check each message for attachments
For Each Item In Inbox.Items
    If blnFound = True Then
        Exit For ' bail after newest item found
    End If
    If Item.Attachments.Count > 0 Then
        ' Save any attachments found
        For Each Atmt In Item.Attachments
        ' This path must exist! Change folder name as necessary.
            If Atmt.Type <> olOLE Then
                If Atmt.FileName Like "RM BSN Status*" Then
                    blnFound = True
                    Atmt.SaveAsFile "P:\Sales_Field\Decoration\Robinson\" & Atmt.FileName
                    i = i + 1
                End If
            End If
         Next Atmt
         
         If i >= 1 Then
            Exit For
         End If
    End If
     
Next Item

If Not blnFound Then
    MsgBox "Error - Decoration Status Report for Robinson not found in Inbox in Outlook"
    ' if you want the code to stop right here,
    Stop
    ' if you want the code to stop running,
    ' End
    Else
    Item.Move Reports
    
End If


' Clear memory
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Function
' Handle errors
GetAttachments_err:
MsgBox "Couldn't get into Outlook or there was an issue retrieving/saving one of the attachments."
    Stop
    GoTo Try_Again:
    '& vbCrLf & "Please note and report the following information." _
    '& vbCrLf & "Macro Name: GetAttachments" _
    '& vbCrLf & "Error Number: " & Err.Number _
    '& vbCrLf & "Error Description: " & Err.Description _
    , vbCritical, "Error!"
Resume GetAttachments_exit
   
End Function

Open in new window


This is evil though
On Error GoTo GetAttachments_err
and you can avoid it by using proper techniques to open Outlook
http://www.experts-exchange.com/articles/17466/Properly-open-Outlook-as-an-Application-object-in-VBA.html

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
bsncpAuthor Commented:
I made a mistake.  Nick67...this solution did not work.  I tested the code and it seemed to work as expected.  But after running it a few times I am having the same problem I had originally.  The code is not finding the most recently received email that meets the criteria.  Sorry...I don't know how to open this discussion up...hope you can continue to help me.
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Nick67Commented:
Ok.

MsgBox is our friend.
Let's pull this logic apart and test it with some MsgBox's to see if we are in fact going in time reverse order, and what filenames we are seeing.
I've reworked the logic with a Do Until

try this

Function AttachmentsMove_DecoStatus_Robinson()
 
Try_Again:
' This Outlook macro checks a the Outlook Inbox for messages
' with attached files (of any type) and saves them to disk.
' NOTE: make sure the specified save folder exists before
' running the macro.
On Error GoTo GetAttachments_err
' Declare variables
Dim myolApp As New Outlook.Application
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Outlook.Attachment
Dim FileName As String
Dim i As Integer
Dim Reports As MAPIFolder
Dim blnFound As Boolean
        
Set myolApp = CreateObject("Outlook.Application")
Set ns = myolApp.GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set Reports = ns.Folders("Personal Folders").Folders("Decoration_Status")

i = 0


' Check Inbox for messages and exit of none found
If Inbox.Items.Count = 0 Then
    MsgBox "There are no messages in the Inbox.", vbInformation, _
           "Nothing Found"
    Exit Function 'bail
End If
blnFound = False

' Sort the inbox into received sequence
Inbox.Items.Sort "[ReceivedTime]", True

' Check each message for attachments
'let's change this up
'we only want the first message to have a desired attachment
Do Until blnFound = True
    For Each Item In Inbox.Items
        'let's see received time and subject and ensure the sort is working
        MsgBox Item.ReceivedTime & " " & Item.Subject
        'not needed with the Do Until in place
'        If blnFound = True Then
'            Exit For ' bail after newest item found
'        End If
        If Item.Attachments.Count > 0 Then
            ' Save the first file attachment with a name like RM BSN Status*, then bail
            For Each Atmt In Item.Attachments
            ' This path must exist! Change folder name as necessary.
                If Atmt.Type <> olOLE Then
                    'let's see the filename
                    MsgBox Atmt.FileName
                    If Atmt.FileName Like "RM BSN Status*" Then
                        blnFound = True
                        Atmt.SaveAsFile "P:\Sales_Field\Decoration\Robinson\" & Atmt.FileName
                        'let's not worry about i, since it's purpose is to exit for
                        'let's just exit
                        Exit For
                        'i = i + 1
                    End If
                End If
             Next Atmt
             
    '         If i >= 1 Then
    '            Exit For
    '         End If
        End If
         
    Next Item
    
Loop

If Not blnFound Then
    MsgBox "Error - Decoration Status Report for Robinson not found in Inbox in Outlook"
    ' if you want the code to stop right here,
    Stop
    ' if you want the code to stop running,
    ' End
    Else
    Item.Move Reports
    
End If


' Clear memory
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Function
' Handle errors
GetAttachments_err:
MsgBox "Couldn't get into Outlook or there was an issue retrieving/saving one of the attachments."
    Stop
    GoTo Try_Again:
    '& vbCrLf & "Please note and report the following information." _
    '& vbCrLf & "Macro Name: GetAttachments" _
    '& vbCrLf & "Error Number: " & Err.Number _
    '& vbCrLf & "Error Description: " & Err.Description _
    , vbCritical, "Error!"
Resume GetAttachments_exit
   
End Function

Open in new window


I am thinking the malfunction was here
Inbox.Items.Sort "[Received]", True
as MailItem doesn't actually have a "[Received]" property
What that will do --like randomize the sort, perhaps -- is anyone's guess
Logically, it should have thrown an error -- but it hasn't
http://blogs.technet.com/b/heyscriptingguy/archive/2008/04/02/how-can-i-sort-items-retrieved-from-a-microsoft-outlook-folder.aspx

If this code works correctly, comment out the MsgBox's and run with it!
bsncpAuthor Commented:
Thanks for continuing to help me!  The message boxes that appear contain very old emails in my Inbox.  I have also run the code multiple times, and it always brings up the same emails, and in the same order, in each Message Box that appears.  None of them appear to be emails that meet the criteria for the subject line.
Nick67Commented:
Well, I put two MsgBox's in
This one

       'let's see received time and subject and ensure the sort is working
        MsgBox Item.ReceivedTime & " " & Item.Subject

was to test the sort order.  If the messages that come up are very old then it's not working.

..And  tested it, and it is not.
But look at the link I posted.
They don't try to work with the folder and items straight up.
Instead, they assign the contents of the folder to an Items collection and sort THAT

So have a go at this (I renamed variables to ensure no keyword collisions ie Item, FileName)
Function AttachmentsMove_DecoStatus_Robinson()
Try_Again:
' This Outlook macro checks a the Outlook Inbox for messages
' with attached files (of any type) and saves them to disk.
' NOTE: make sure the specified save folder exists before
' running the macro.
    On Error GoTo GetAttachments_err
' Declare variables
Dim myolApp As New Outlook.Application
Dim ns As NameSpace
Dim TheInbox As MAPIFolder
Dim myItem As Object
Dim MyItems As Outlook.Items
Dim Atmt As Outlook.Attachment
Dim TheFileName As String
Dim Reports As MAPIFolder
Dim blnFound As Boolean
        
Set myolApp = CreateObject("Outlook.Application")
Set ns = myolApp.GetNamespace("MAPI")
Set TheInbox = ns.GetDefaultFolder(olFolderInbox)

' Check Inbox for messages and exit of none found
If TheInbox.Items.Count = 0 Then
    MsgBox "There are no messages in the Inbox.", vbInformation, _
           "Nothing Found"
    Exit Function 'bail
End If
blnFound = False
Set MyItems = TheInbox.Items
' Sort the inbox into received sequence
MyItems.Sort "[ReceivedTime]", True

' Check each message for attachments
'we only want the first message to have a desired attachment
Do Until blnFound = True
    For Each myItem In MyItems
        If myItem.Attachments.Count > 0 Then
            ' Save the first file attachment with a name like RM BSN Status*, then bail
            For Each Atmt In myItem.Attachments
            ' This path must exist! Change folder name as necessary.
                If Atmt.Type <> olOLE Then
                    If Atmt.FileName Like "RM BSN Status*" Then
                        blnFound = True
                        Atmt.SaveAsFile "P:\Sales_Field\Decoration\Robinson\" & Atmt.FileName
                        Exit For
                    End If
                End If
             Next Atmt
        End If
         
    Next myItem
    
Loop

If Not blnFound Then
    MsgBox "Error - Decoration Status Report for Robinson not found in Inbox in Outlook"
    ' if you want the code to stop right here,
    Stop
    ' if you want the code to stop running,
    ' End
    Else
    myItem.Move Reports
    
End If


' Clear memory
GetAttachments_exit:
Set Atmt = Nothing
Set myItem = Nothing
Set ns = Nothing
Exit Function
' Handle errors
GetAttachments_err:
MsgBox "Couldn't get into Outlook or there was an issue retrieving/saving one of the attachments."
    Stop
    GoTo Try_Again:
    '& vbCrLf & "Please note and report the following information." _
    '& vbCrLf & "Macro Name: GetAttachments" _
    '& vbCrLf & "Error Number: " & Err.Number _
    '& vbCrLf & "Error Description: " & Err.Description _
    , vbCritical, "Error!"
Resume GetAttachments_exit


End Function

Open in new window

Nick67Commented:
None of them appear to be emails that meet the criteria for the subject line.
That's not what you're code is actually hunting down, right.
I threw in subject in the msgbox because it is easily recognizable

Your code is looking for the newest attachment named like "RM BSN Status*", right?
bsncpAuthor Commented:
Ahhh...sorry!  Right, the criteria is the attachment name, not the subject line.  This new code doesn't find the emails at all.  Instead, I get the error handling message "Couldn't get into Outlook or there was an issue retrieving/saving one of the attachments."
bsncpAuthor Commented:
Here is some additional information...your original code seemed to work great.  But as I mentioned, it only worked the first time I ran it.  Interestingly, if I ran it a second time it pulled the second nesest email.  The third time...it pulled the 3rd newest.  and so on until it starts over. I have 5 emails in my Inbox that will meet the criteria of the code.  They have Received dates of:
10/23/2015
10/20/2015
10/16/2015
10/13/2015
10/9/2015

To test your code, I run it and it finds the newest email that meets the criteria.  Then I put that email back in the Inbox since the code moves it to another folder when it is found.  Then I repeat...and like I mention above each time I run it, the code returns what I described above.  Very strange.
Nick67Commented:
Ok,

Here is code that runs in my Outlook 2003 without errors
I have a MsgBox in it to throw out receivedtime, subject and attachment name every occasion where an attachment of the right filetype exists.

Function AttachmentsMove_DecoStatus_Robinson()
Try_Again:
' This Outlook macro checks a the Outlook Inbox for messages
' with attached files (of any type) and saves them to disk.
' NOTE: make sure the specified save folder exists before
' running the macro.
    On Error GoTo GetAttachments_err
' Declare variables
Dim myolApp As New Outlook.Application
Dim ns As NameSpace
Dim TheInbox As MAPIFolder
Dim myItem As Object
Dim MyItems As Outlook.Items
Dim Atmt As Outlook.Attachment
Dim TheFileName As String
Dim Reports As MAPIFolder
Dim blnFound As Boolean
        
Set myolApp = CreateObject("Outlook.Application")
Set ns = myolApp.GetNamespace("MAPI")
Set TheInbox = ns.GetDefaultFolder(olFolderInbox)

' Check Inbox for messages and exit of none found
If TheInbox.Items.Count = 0 Then
    MsgBox "There are no messages in the Inbox.", vbInformation, _
           "Nothing Found"
    Exit Function 'bail
End If
blnFound = False
Set MyItems = TheInbox.Items
' Sort the inbox into received sequence
MyItems.Sort "[ReceivedTime]", True

' Check each message for attachments
'we only want the first message to have a desired attachment
Do Until blnFound = True
    For Each myItem In MyItems
        If myItem.Attachments.Count > 0 Then
            ' Save the first file attachment with a name like RM BSN Status*, then bail
            For Each Atmt In myItem.Attachments
                MsgBox myItem.ReceivedTime & " " & myItem.Subject & " " & Atmt.FileName
            ' This path must exist! Change folder name as necessary.
                If Atmt.Type <> olOLE Then
                    If Atmt.FileName Like "RM BSN Status*" Then
                        blnFound = True
                        Atmt.SaveAsFile "P:\Sales_Field\Decoration\Robinson\" & Atmt.FileName
                        Exit For
                    End If
                End If
             Next Atmt
        End If
         
    Next myItem
    
Loop

If Not blnFound Then
    MsgBox "Error - Decoration Status Report for Robinson not found in Inbox in Outlook"
    ' if you want the code to stop right here,
    Stop
    ' if you want the code to stop running,
    ' End
    Else
    myItem.Move Reports
    
End If


' Clear memory
GetAttachments_exit:
Set Atmt = Nothing
Set myItem = Nothing
Set ns = Nothing
Exit Function
' Handle errors
GetAttachments_err:
MsgBox "Couldn't get into Outlook or there was an issue retrieving/saving one of the attachments."
    Stop
    GoTo Try_Again:
    '& vbCrLf & "Please note and report the following information." _
    '& vbCrLf & "Macro Name: GetAttachments" _
    '& vbCrLf & "Error Number: " & Err.Number _
    '& vbCrLf & "Error Description: " & Err.Description _
    , vbCritical, "Error!"
Resume GetAttachments_exit


End Function

Open in new window


Now, as you noted, the code moves the mailitem to folder "Reports" in some instances

If Not blnFound Then
    MsgBox "Error - Decoration Status Report for Robinson not found in Inbox in Outlook"
    ' if you want the code to stop right here,
    Stop
    ' if you want the code to stop running,
    ' End
Else
    myItem.Move Reports
   
End If


I've never been a big fan of If Not someBoolan then
It's hard to interpret
But it looks like the newest mailitem with a desired attachment gets MOVED to 'Reports' when the code runs.

But you have error handling in play -- and that's bad for debugging
I think what may be happening is that
Atmt.SaveAsFile "P:\Sales_Field\Decoration\Robinson\" & Atmt.FileName
may cause an error when an overwrite happens -- because you are putting the messages back to reprocess!

Let me know how this code block functions
And if you are reprocessing messages by putting them back in the Inbox, ensure that you've cleaned up P:\Sales_Field\Decoration\Robinson\ to not have the files in it.
bsncpAuthor Commented:
This code generates a message box for every attachment for every email, starting with the most recent.  So the descending order sorting appears to be working, but it is grabbing every email in my Inbox and looping through the attachments instead of just doping that with the most recent email that meets the criteria.

I have not been removing the file from the directory P:\Sales_Field\Decoration\Robinson\ every time I re-process the code.  I didn't think I needed to since the file is just being overwritten.
Nick67Commented:
This code generates a message box for every attachment for every email, starting with the most recent.
Good.
but it is grabbing every email in my Inbox and looping through the attachments
That is the design.

Now if it finds a correctly named attachment

                    If Atmt.FileName Like "RM BSN Status*" Then
                        blnFound = True
                        Atmt.SaveAsFile "P:\Sales_Field\Decoration\Robinson\" & Atmt.FileName
                        Exit For


It should stop looking for further attachment and set blnFound = True and complete the loop

when blnFound = True is true the Do While loop should exit
Do Until blnFound = True

and carry on down to the lower section
If Not blnFound Then

instead of just stopping that with the most recent email that meets the criteria.


Note that you have NO criteria for the emails themselves, only for names of attachments

So move
MsgBox myItem.ReceivedTime & " " & myItem.Subject & " " & Atmt.FileName
below line 44 of the code block above and run it and post results.
bsncpAuthor Commented:
Here are the results...there are 6 emails in my Inbox that meet the criteria based on attachment name.  After moving the MsgBox code line as you recommended and running the code, the message box appears with the information for the most recent email meeting the criteria.  When I click OK, the message box appears with the info from the second most-recent email fitting the criteria.  Then the third most-recent email and so on.  This continues until the last of the 6 emails is found.  When  I click OK after the 6th email, the code then jumps to the error handling at the bottom and the message box reads "Couldn't get into Outlook or there was an issue retrieving/saving one of the attachments."
Nick67Commented:
Good enough, we know where the grief is:
                   If Atmt.FileName Like "RM BSN Status*" Then
                        blnFound = True
                        Atmt.SaveAsFile "P:\Sales_Field\Decoration\Robinson\" & Atmt.FileName
                        Exit For
                    End If


Now, setting blnFound = True is SUPPOSED to collapse the Do Until Loop
But that isn't happening

So, let's turn the logic around, cleanup any non-explicit handlings and msgbox the problem
Here's an altered snippet

' Check each message for attachments
'we only want the first message to have a desired attachment
Do while blnFound = false
    For Each myItem In MyItems
        If myItem.Attachments.Count > 0 Then
            ' Save the first file attachment with a name like RM BSN Status*, then bail
            For Each Atmt In myItem.Attachments                
            ' This path must exist! Change folder name as necessary.
                If Atmt.Type <> olOLE Then
                    If Atmt.FileName Like "RM BSN Status*" Then
                        blnFound = True
                        Atmt.SaveAsFile "P:\Sales_Field\Decoration\Robinson\" & Atmt.FileName
                        MsgBox myItem.ReceivedTime & " " & myItem.Subject & " " & Atmt.FileName
                        Msgbox blnFound
                        Exit For
                    Else
                        blnFound = False
                    End If
                End If
             Next Atmt
        End If
         
    Next myItem
    
Loop

Open in new window

It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.