Re-Open attachments from multiple folders, Copy contents from all attachments and save in Master File sheet

This task is achievable with user request such as:

FileToOpen = Application.GetOpenFilename(Filefilter:="Excel Files (*.xlsx), *.xlsx", Title:="Select 
Workbook to Import", MultiSelect:=True)

    If IsArray(FileToOpen) Then           
        For FileCount = 1 To UBound(FileToOpen)
            shNewDat.Cells.Clear
            LastRow = shAll.Cells(Rows.Count, 1).End(xlUp).Row + 1 
            Set SelectedBook = Workbooks.Open(FileName:=FileToOpen(FileCount))
            SelectedBook.Worksheets("Sheet1").Cells.Copy    
            shNewDat.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats

             SelectedBook.Close
            LastTempRow = shNewDat.Cells(Rows.Count, 2).End(xlUp).Row 'locate last row in the RAWData Temp tab

Situation: In this instance, I require that the user doesn't interact with data (manually multiple selecting data). We need to access excel files in multiple folders (limited to the day of download from outlook) to open as soon as attachments from outlook has been downloaded into their respective folders. Then, I would need to loop through to copy contents from all selected sheets to 1 Excel file (Masterfile). Following day, this should continue without attachment/data being pulled through from 2 days or more back (only the day before - the downloaded attachments) Please view current entire code that pulls attachments from outlook and I'm currently stuck at this point.

I would pleade that we stick to the coding convention for cleaner faster processing please:

Sub SaveOutlookAttachments()

Dim objOutlook As New Outlook.Application
Dim objNamespace As Outlook.Namespace
Dim objFolder As Outlook.Folder

Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.Folders(1).Folders("Inbox")

ProcessMails objFolder, "compa", "North", "compa  Report UpTo", "compa North Region Report"
ProcessMails objFolder, "compa", "South", "compa  Report UpTo", "compa South Region Report"
ProcessMails objFolder, "compa", "East", "compa  Report UpTo", "compa East Region Report"
ProcessMails objFolder, "compa", "West", "compa  Report UpTo", "compa West Region Report"


End Sub

Sub ProcessMails(srcFolder As Outlook.Folder, compName As String, subj As String, _
             saveFolder As String, saveFileName As String)

Const ROOT_FOLDER As String = "C:\Users\rootname\OneDrive\Desktop\VBATesting\"

Dim objItem As Object, objMailItem As Outlook.MailItem, dirFolderName As String
Dim objAttachment As Outlook.Attachment

For Each objItem In srcFolder.Items.Restrict(PFilter(compName, subj))
    If objItem.Class = Outlook.olMail Then 'Check Item Class

        Set objMailItem = objItem 'Set as Mail Item

        If ProcessThisMail(objMailItem) Then
            With objMailItem

                dirFolderName = ROOT_FOLDER & saveFolder & _
                                Format(objMailItem.ReceivedTime, "yyyy-mm") & "\"

                EnsureSaveFolder dirFolderName

                Debug.Print "Message:", objMailItem.Sender, objMailItem.ReceivedTime, objMailItem.Subject

                For Each objAttachment In .Attachments
                    Debug.Print , "Attachment:", objAttachment.Filename

                    objAttachment.SaveAsFile dirFolderName & _
                          saveFileName & Format(objMailItem.ReceivedTime, "yyyy-mm-dd")
                Next

            End With
        End If 'processing this one
    End If 'is a mail item
Next objItem
End Sub

'return a filter for company and subject
Function PFilter(sCompany, sSubj)
PFilter = "@SQL=""urn:schemas:httpmail:fromname"" LIKE '%@"& sCompany & "%'"& _
          "AND ""urn:schemas:httpmail:subject"" LIKE '%"& sSubj & "%'"
End Function

'Abstract out the rules for when a mail is processed
Function ProcessThisMail(theMail As Outlook.MailItem) As Boolean
Dim iBackdate As Long
If theMail.Attachments.Count > 0 Then
    Select Case Weekday(Now)
        Case 7: iBackdate = 3 ' Saturday: add extra day
        Case 1, 2, 3: iBackdate = 4 ' Sunday through Tuesday: add extra 2 days
        Case Else: iBackdate = 2 ' Other days
    End Select
    If theMail.ReceivedTime > DateAdd("d", -iBackdate, Now) Then
        ProcessThisMail = True 'will by default return false unless this line is reached
    End If
End If
End Function

'ensure a subfolder exists
Sub EnsureSaveFolder(sPath As String)
With CreateObject("scripting.filesystemobject")
    If Not .FolderExists(sPath) Then
        .CreateFolder sPath
    End If
End With
End Sub

Many thanks in advance