Search Outlook attachments limited to a weekday before and save attachments - vba

Question

I want search though Outlook folders of now to previous weekday, so will exclude weekends, and if file doesn’t exist, output “this report was not sent on date”.
And for file to save as: following a condition that the title of the heading contains some text at most two. And that the file will be saved with the two found letters in the body of the title.
I want to do this for six different cases.
Sub SaveOutlookAttachments()
Dim ol As Outlook.Application
Dim ns As Outlook.Namespace
Dim ofolder As Outlook.folder
Dim i As Object
Dim mi As Outlook.MailItem
Dim at As Outlook.Attachment
Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
Set ofolder = ns.Folders(1).Folders("Inbox")
For Each i In ofolder.Items
If i.Class = olMail Then
Set mi = i 'This ensure that were looking at an email object rather than any potential item
'I need to find a way to create a case or an if statement that would reference 2 keywords in the title of the email subject in order to download and save the file with those keywords + date at the end.
'The logic is to use the title to distinguish between 4 regional reports for 1 Partner and 3 reports for 3 different partners. These would save files in their names associated with the title of the email. Eg: Comp.ABC Regional Reports 20/10/2019. I should also only search for previous days only within weekdays/working days - Mondays to Fridays.
Debug.Print mi.SenderName, mi.ReceivedTime, mi.Attachments.Count
For Each at In mi.Attachments
at.SaveAsFile "C:\Users\rootname\OneDrive\Desktop\VBATesting" & at.FileName & Format(mi.ReceivedTime, "dd-mm-yyyy") 'Put in a valid folder location to store attachements
Next at
End If
Next i
End Sub

Answer 1

Here's code that first checks the MailItem's ReceivedTime for the Date condition (you can go further and exclude weekends). Then it checks the MailItem's Subject for Keywords from a colKeywords collection you can edit and add to. It also This should get you pretty close to what you want to do. I've also renamed the variables for clarity:
Dim objOutlook As New Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objFolder As Outlook.Folder
Dim objItem As Object
Dim objMailItem As Outlook.MailItem
Dim objAttachment As Outlook.Attachment
Dim colKeywords As New Collection
Dim sKeyword As String
Dim iCounter As Integer
Dim iBackdate As Integer
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.Folders(1).Folders("Inbox")
' Add your Keywords here
colKeywords.Add "keyword1"
colKeywords.Add "keyword2"
For Each objItem In objFolder.Items
' Check Item Class
If objItem.Class = Outlook.olMail Then
' Set as Mail Item
Set objMailItem = objItem
With objMailItem
Select Case Weekday(Now)
Case 7 ' Saturday: add extra day
iBackdate = 3
Case 1, 2, 3 ' Sunday through Tuesday: add extra 2 days
iBackdate = 4
Case Else ' Other days
iBackdate = 2
End Select
' Check date
If .ReceivedTime > DateAdd("d", -iBackdate, Now) Then
' Loop through all keywords
For iCounter = 1 To colKeywords.Count
' Get keyword
sKeyword = colKeywords.Item(iCounter)
' Check if keyword exists
If InStr(.Subject, sKeyword) > 0 Then
' Save Attachments
For Each objAttachment In .Attachments
objAttachment.SaveAsFile "C:\Users\rootname\OneDrive\Desktop\VBATesting" & objAttachment.FileName & Format(.ReceivedTime, "dd-mm-yyyy") 'Put in a valid folder location to store attachements
Next
End If
Next
End If
End With
End If
Next