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/showthread.php?54989-Find-and-Open-an-email-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