Save email attachment macro - Only the last email

[thenewworld]

Hi guys

I've ran into some problems with my macro. Originally it's used to save daily excel-attachments from outlook locally. The macro search for the matching subject in my inbox and downloads it. Afterwards i move the email to a archive-folder in outlook, rinse and repeat.

We now want to send out these reports hourly and it's too much work to move the emails every hour so i have made a rule that moves the reports to a specific folder. Problem arises when my macro search in this folder it probably gets multiple hits and just keeps on running, finally saving the oldest attachment. Can my macro be tweaked so it saves only the latest attachment that i have received.

Macro as of today:

Sub ImportEmail()
    
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object
    Dim A As String, B As String, C As String, D As String, E As String, F As String, G As String, H As String
      
    
    A = Sheets("Sheet1").Range("E2").Value
    B = Sheets("Sheet1").Range("E3").Value
    C = Sheets("Sheet1").Range("E4").Value
    D = Sheets("Sheet1").Range("E5").Value
    F = Sheets("Sheet1").Range("E6").Value
    G = Sheets("sheet1").Range("E7").Value
    
    H = Sheets("sheet1").Range("E8").Value
    
    E = Sheets("Sheet1").Range("J2").Value
    
    Set oOlAp = CreateObject("Outlook.Application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
        
    Set oOlInb = oOlns.Folders("[I]Shared mailbox[/I]")
    Set oOlInb = oOlInb.Folders([I]"archive-folde[/I]r")
    For Each oOlItm In oOlInb.Items

    If oOlItm.Subject Like "*" & F & "*" Then
            For Each oOlAtch In oOlItm.Attachments
            oOlAtch.SaveAsFile E & F & ".xlsx"
            Exit For
            Next
    ElseIf oOlItm.Subject Like "*" & C & "*" And C <> "" Then
            For Each oOlAtch In oOlItm.Attachments
            oOlAtch.SaveAsFile E & C & ".xlsx"
            Exit For
            Next
    ElseIf oOlItm.Subject Like "*" & D & "*" And D <> "" Then
            For Each oOlAtch In oOlItm.Attachments
            oOlAtch.SaveAsFile E & D & ".xlsx"
            Exit For
            Next


    End If
    Next

End Sub