VBA in MS Outlook to filter by date and subject, extract attachment, save and replace previous file in folder

Question

I get a generated report by Oracle web app every week. I got a macro working to extract that attachment report from my email, but for some reason the date filter doesn't do anything and it saves all the attachments with the email subject "VERIPRD: XXVER Veritiv Aging Report Main: PETROP01" (which is the subject of the report that I want, but I get this weekly, and I only need to extract the most current one)

Also, the report comes with a .out extension which can be opened up with Excel, but if I save that file within the macros as xlsx it gets corrupted.

So what I need is for this macro to actually filter by date, and Subject line (mentioned above), save the .out file as an Excel file titled "Aging Report" and, if there's already an "Aging Report" in destination folder, to replace that previous excel file and not prompt with a message asking me if I want to replace it.

Here's the code I have so far which I put in MS outlook:

Public Sub Extract_Outlook_Email_Attachments()
 Dim OutlookOpened As Boolean
 Dim outApp As Outlook.Application
 Dim outNs As Outlook.NameSpace
 Dim outFolder As Outlook.MAPIFolder
 Dim outAttachment As Outlook.attachment
 Dim outItem As Object
 Dim saveFolder As String
 saveFolder = "C:\Users\borjax01\Desktop\aging reports"
 Dim outMailItem As Outlook.MailItem
 Dim inputDate As String, subjectFilter As String
 If Right(saveFolder, 1) <> "\" Then saveFolder = saveFolder & "\" & "Aging 
 Report.out"

 inputDate = InputBox("Enter date to filter the email subject", "Extract 
 Outlook email attachments")
 If inputDate = "" Then Exit Sub

 InputDateFilter = inputDate
 subjectFilter = ("VERIPRD : XXVER Veritiv Aging Report Main : PETROP01")


 OutlookOpened = False
 On Error Resume Next
 Set outApp = GetObject(, "Outlook.Application")
 If Err.Number <> 0 Then
     Set outApp = New Outlook.Application
     OutlookOpened = True
 End If
 On Error GoTo 0

 If outApp Is Nothing Then
     MsgBox "Cannot start Outlook.", vbExclamation
     Exit Sub
 End If

 Set outNs = outApp.GetNamespace("MAPI")
 Set outFolder = outNs.PickFolder


 If Not outFolder Is Nothing Then
    For Each outItem In outFolder.Items
        If outItem.Class = Outlook.OlObjectClass.olMail Then
            Set outMailItem = outItem
             If outMailItem.Subject = subjectFilter Then
                 Debug.Print outMailItem.Subject
                 For Each outAttachment In outMailItem.Attachments
                outAttachment.SaveAsFile saveFolder


              Set outAttachment = Nothing


                 Next
             End If
         End If
     Next
 End If

 If OutlookOpened Then outApp.Quit

 Set outApp = Nothing

End Sub

Answer 1

A post might get answers more quickly if broken into multiple single questions as is expected in this Q & A.

Public Sub Extract_Outlook_Email_Attachments()

    Dim OutlookOpened As Boolean
    Dim OutApp As outlook.Application
    Dim outNs As outlook.Namespace
    Dim outFolder As outlook.MAPIFolder
    Dim outAttachment As outlook.Attachment
    Dim outItem As Object
    Dim saveFolder As String

    Dim outMailItem As outlook.MailItem
    Dim inputDate As String, subjectFilter As String

    Dim fldrItems As Items
    Dim resultItems As Items

    Dim strFilter As String

    saveFolder = "C:\Users\borjax01\Desktop\aging reports"
    saveFolder = "H:\test2"

    'If Right(saveFolder, 1) <> "\" Then saveFolder = saveFolder & "\" & "Aging Report.out"
    If Right(saveFolder, 1) <> "\" Then saveFolder = saveFolder & "\"

    ' subjectFilter = ("VERIPRD : XXVER Veritiv Aging Report Main : PETROP01")

    ' No "Re:" nor "Fw:"
    subjectFilter = "VERIPRD : XXVER Veritiv Aging Report Main : PETROP01"

    OutlookOpened = False
    On Error Resume Next
    Set OutApp = getObject(, "Outlook.Application")
    If Err.number <> 0 Then
        Set OutApp = New outlook.Application
        OutlookOpened = True
    End If
    On Error GoTo 0

    If OutApp Is Nothing Then
        MsgBox "Cannot start Outlook.", vbExclamation
        Exit Sub
    End If

    Set outNs = OutApp.GetNamespace("MAPI")
    Set outFolder = outNs.PickFolder

    If Not outFolder Is Nothing Then

        Set fldrItems = outFolder.Items

        strFilter = "[Subject] = '" & subjectFilter & "'"
        Debug.Print strFilter

        Set resultItems = fldrItems.Restrict(strFilter)
        'Debug.Print resultItems.count

        resultItems.Sort "[ReceivedTime]", True

        For Each outItem In resultItems

            If outItem.Class = outlook.OlObjectClass.olMail Then

                Set outMailItem = outItem

                If outMailItem.subject = subjectFilter Then

                    Debug.Print " outMailItem.subject: " & outMailItem.subject
                    Debug.Print " outMailItem.ReceivedTime: " & outMailItem.ReceivedTime

                    For Each outAttachment In outMailItem.Attachments
                        Debug.Print " outAttachment.DisplayName: " & outAttachment.DisplayName
                        If InStr(outAttachment.DisplayNamem, ".out") Then
                            outAttachment.SaveAsFile saveFolder & outAttachment.DisplayName
                            Exit Sub    '<-- exit when most recent is saved
                        End If
                    Next

                End If
            End If
        Next
    End If

    If OutlookOpened Then OutApp.Quit

    Set OutApp = Nothing

End Sub