Open Latest Outlook email by Received Date

[Poundland]

Hi Guys,

I have adapted the below code, which was given to me by Mancubus on this forum, and it works, issue now is that where there are more than 1 email with the same part description it opens and saves attachments from all of them.

I need to add a reference to only open the latest email by the received date, I have tried adapting the If Then statement to incorporate the ReceivedTime but this just errors. The original If Then statement is commented.

Can you please point me in the direction of adding in the latest received date to the code so that only the latest version of the email is opened.

Many Thanks

Private Sub Image21_Click()
 Dim olMail As Object, olAtt As Object, pdat As Date
    Dim strSaveToFolder As String, strPathAndFilename As String, Monday As String
     pdat = Format(Now, "dd/mm/yyyy")
   
     'Monday = DateAdd("ww", -1, pdat - (Weekday(pdat, vbMonday) - 8))
    strSaveToFolder = "I:\H904 Supply Chain\Scott Atkinson\Dashboard\"
     On Error GoTo errorhandler
    With CreateObject("Outlook.Application")
        For Each olMail In .GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
            'If InStr(olMail.Subject, "Availability Measurement by SKU was executed at " & pdat) > 0 Then
            If InStr(olMail.Subject, "Availability Measurement by SKU was executed at " & pdat) > 0 And _
            "[ReceivedTime]" = pdat Then
                If olMail.Attachments.Count > 0 Then
                    For Each olAtt In olMail.Attachments
                    Application.DisplayAlerts = False
                        strPathAndFilename = strSaveToFolder & Format(pdat, "dd.mm.yyyy") & " " & olAtt.Filename
                            olAtt.SaveAsFile strPathAndFilename
                            olMail.Save
                            Application.DisplayAlerts = True
                    Next olAtt
                End If
            End If
        Next
              On Error GoTo 0
    End With
  
     On Error Resume Next
     Kill (strSaveToFolder & Format(pdat - 1, "dd.mm.yyyy") & " Availability Measurement by SKU.xlsx")
     Kill (strSaveToFolder & Format(pdat - 3, "dd.mm.yyyy") & " Availability Measurement by SKU.xlsx")
      On Error GoTo 0
      On Error GoTo errorhandler
      Application.DisplayAlerts = False
        Workbooks.Open (strSaveToFolder & Format(pdat, "dd.mm.yyyy") & " Availability Measurement by SKU.xlsx")
       Application.DisplayAlerts = True
       On Error GoTo 0
     Exit Sub
errorhandler:
     MsgBox ("OOOPPPS it appears that this report has not yet been issued by IT, or you may not be authorised to view it.")
End Sub

[snb]

You can filter items in Outlook; use then method .Restrict
If you move the email after having saved its attachment(s) things stay simple:

Sub M_snb()
  c00 = "Availability Measurement by SKU was executed at " & format(date,"dd/mm/yyyy")

  With CreateObject("Outlook.Application").GetNamespace("MAPI")
    For Each it In .GetDefaultFolder(6).Items.Restrict("[Subject]='" & c00 & "'") 
      for each at in it.attachments
        at.Saveasfile  "I:\H904 Supply Chain\Scott Atkinson\Dashboard\" & at.name
      next
      it.Move .GetDefaultFolder(3)
    Next
  End With
End Sub

[mancubus]

and this is the link to the previous thread:

http://www.vbaexpress.com/forum/show...ail-in-Outlook

@Pondland
try snb's codes in both threads of yours.



EDIT:
Since this thread is continuation of the above thread, pls ask a moderator to merge the threads.

[Poundland]

snb,

Thank you for your reply, I intend to use the same code for different email subjects, some of which will not have dates in the subject text, using this how can I open just the last received email attachment based on the received date?

[Poundland]

snb,

Sorry, I have tried your code and it does not find any emails in my Outlook, I know the email is there and when I use the original code given to me by Mancubus, it finds and saves the attachment.

[snb]

What's the date format ?

[Poundland]

I have added a MsgBox to see what ReceivedTime is being captured, and it is the first ever email that I have received with the subject string in it. The date format that is showing in the message box is "dd/mm/yyyy hh:mm:ss" I want to be able to find the email based on the received date only so the format would be "dd/mm/yyyy"

[snb]

I mean: what is the Subject text of the email you are looking for ?

[Poundland]

Sorry, the subject text of the email is "SKU Range Daily Availability - Full Version" it gets emailed to me each day and I need to save the attachment on the email from the latest received email.

[mancubus]

.................

[mancubus]

delete previosly received emails. snb's code will copy the attachment and move the mail to Deleted Items (.GetDefaultFolder(3)) folder.

if you want to keep emails, first create a folder (in Inbox, SKU_Mails for example), move previous emails to this folder and run the code every day.

as an example, change it.Move .GetDefaultFolder(3) to it.Move .GetDefaultFolder(6).Folders("SKU_Mails")


i think snb will correct the subject bit.



one correction: change at.Name to at.FileName

[Poundland]

OK, thank you for the explanation as to what the code does.

I noticed that snb's code finds the earliest received email that meets the criteria, saves this attachment, then finds the next earliest received, and so on a so forth until it reaches the latest received email.

Is there no way that the code can be manipulated to only select the last received email with the required subject and attachment rather than move emails to another folder?

The reason I ask, is that the finished code will be installed on many peoples machines, and not everybody will either want to move their emails, delete them or have permissions to do either of the two.

[snb]

If you keep all those emails in this folder the checking of all those emails will become slower each day.
What's the point in not deleting/moving the accompanying email ?
The mail only serves as the vehicle to send you the attachment.
It's the attachment that matters, not its 'envelope'

Sub M_snb() 
    c00 = "SKU Range Daily Availability - Full Version"
     
    With CreateObject("Outlook.Application").GetNamespace("MAPI") 
        For Each it In .GetDefaultFolder(6).Items.Restrict("[Subject]='" & c00 & "'") 
            For Each at In it.attachments 
                at.Saveasfile  "I:\H904 Supply Chain\Scott Atkinson\Dashboard\" & at.filename 
            Next 
            it.Move .GetDefaultFolder(3) 
        Next 
    End With 
End Sub

as an alternative you can change the mail's subject, so you will only filter the most recent email:

Sub M_snb()
  c00 = "SKU Range Daily Availability - Full Version"            
  With CreateObject("Outlook.Application").GetNamespace("MAPI")
    For Each it In .GetDefaultFolder(6).Items.Restrict("[Subject]='" & c00 & "'")
      For Each at In it.attachments
       at.Saveasfile  "I:\H904 Supply Chain\Scott Atkinson\Dashboard\" & at.filename
      Next

      it.subject="old"
      it.save
    Next
  End With
  End Sub

[Poundland]

Just checked on my machine, and other peoples in my company will be roughly the same, there were over 250 emails with the same subject heading with attachments from the earliest received date to the latest received date, the code would save the attachment over 250 times before it reached the latest email.

Because my company has cloud storage, people in my company keep emails over many years, that is why it is very important for me to find the latest received email each time the code is run and not cycle through all the iterations from the earliest date to the latest.

[Poundland]

snb,

Thank you for your assistance, I know I am probably frustrating you right now, and I apologize for that.

Changing the subject of the email to something other than it is again is not an option, this will ultimately run on many peoples machines, so I cannot change their email subjects.

I really need to find a way to find the latest received email the first time, and then stop searching.

[Poundland]

I have added a couple of lines of code, hoping to review the ReceivedTime email variable and perform an action based on a True or False response, it works on the first email found but not on subsequent emails... very frustrating..

Private Sub Image5_Click()
Dim strRT As String
 strRT = (Date - 1 & " 23:59")
 c00 = "SKU Range Daily Availability - Full Version"
     
    With CreateObject("Outlook.Application").GetNamespace("MAPI")
        For Each it In .GetDefaultFolder(6).Items.Restrict("[Subject]='" & c00 & "'")
        ' additional code line added. The first found email returns False and skips the save file process
        ' but all subsequent emails are treated as True even when they are not and files are saved
        If it.ReceivedTime > strRT Then
        
    
            For Each at In it.Attachments
                at.SaveAsFile "I:\H904 Supply Chain\Scott Atkinson\Dashboard\" & at.Filename
            Next
            'it.Move .GetDefaultFolder(3)
Else
End If
        Next
    End With
End Sub

[Poundland]

OK, I have now cracked this, ironically by reviewing a post on this forum in the Outlook section.

The Code below now searches for the subject in the outlook inbox but also searches for the Received Time that is less than the previous day at midnight, and then saves that attachment to file only.

Thank you for snb for your code and your patience, and thank you to Mancubus for his original code. This forum and it's members rock..

Private Sub Image5_Click()
Dim strRT As String
 'strRT = Quote(Format(Date - 1, "ddddd")) ' & " 23:59")
 strRT = Format(Date - 1, "ddddd") & " 23:59"
 c00 = "SKU Range Daily Availability - Full Version"
     
    With CreateObject("Outlook.Application").GetNamespace("MAPI")
        For Each it In .GetDefaultFolder(6).Items.Restrict("[Subject]= '" & c00 & "' and [ReceivedTime] > '" & strRT & "'")
       
       ' MsgBox (it.ReceivedTime)
    
            For Each at In it.Attachments
                at.SaveAsFile "I:\H904 Supply Chain\Scott Atkinson\Dashboard\" & at.Filename
            Next
            'it.Move .GetDefaultFolder(3)
        Next
    End With
End Sub

[SamT]

Her's another option based on the code in your first post.

 Dim ThisOne As Object
 Dim LatestTime As Date
 
'Find the lastest email   
 With CreateObject("Outlook.Application") 
        For Each olMail In .GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items 
             'If InStr(olMail.Subject, "Availability Measurement by SKU was executed at " & pdat) > 0 Then
            If InStr(olMail.Subject, "Availability Measurement by SKU was executed at " & pdat) > 0 And _ 
            "[ReceivedTime]" = pdat Then 'The Time part of pdat is 00:00:00
               If "[ReceivedTime]" > LatestTime Then
                  LatestTime = "[ReceivedTime]"
                  Set ThisOne = oMail
                End If 
            End If 
        Next 
        On Error GoTo 0 
    End With 
'Process only the latest
                 If Not ThisOne is Nothing And ThisOne.Attachments.Count > 0 Then 
                    For Each olAtt In olMail.Attachments 
                        Application.DisplayAlerts = False 
                        strPathAndFilename = strSaveToFolder & Format(pdat, "dd.mm.yyyy") & " " & olAtt.Filename 
                        olAtt.SaveAsFile strPathAndFilename 
                        olMail.Save 
                        Application.DisplayAlerts = True 
                   Next olAtt 
                  End If