How to get outlook email attachment using excel vba and save it in a specified folder

Hello, I am currently using the code below to save a file and send an email with a link to the file on our server. What I would also like to do is before the email is sent, look through outlook folders and find an attachment based on a range value in the worksheet. When it finds the attachment I would like to transfer it into the same folder that we are saving the current file into. This project is the first time that I have tried to do anything with outlook from excel so I am having trouble figuring out how to make this work.

Sub CreateFolderandSaveFile()
Dim wb As Workbook
Dim ws As Worksheet
Dim suffix, suffix1, fName, fName1, fName2, fpath,  As String, 

Set wb = ThisWorkbook
Set ws = ThisWorkbook.Sheets("Change Order Report")
Set ws2 = ThisWorkbook.Sheets("Hidden For VBA")

If Range("CORCODesc") = "" Then
    MsgBox "Please enter a general description for this Change Order"
    Range("CORCODesc").Select
    Exit Sub
Else
    'Do Nothing
End If

If Range("CORProjectNo") = "" Then
    MsgBox "Please enter a Project Number"
    Range("CORProjectNo").Select
    Exit Sub
Else
    'Do Nothing
End If

If Range("CORCONo") = "" Then
    MsgBox "Please enter a Change Order Number"
    Range("CORCONo").Select
    Exit Sub
Else
    'Do Nothing
End If

For Each Cell In Range("Directory")
    If Cell = "" Then
        'do nothing
    ElseIf Len(Dir(Cell, vbDirectory)) = 0 Then
        MkDir Cell
    End If
Next Cell

suffix = ".xlsm"
suffix1 = ".pdf"
fpath = Range("COFolder") & "\"
fName = Range("CORProjectNo") & " CO-" & Range("CORCONo") & " " & Range("CORCODesc") _
        & " Qty. " & Range("CORLine1Qty") & " COReportBA"
fName1 = fpath + fName + suffix
fName2 = fpath & Range("CORCustPONo") + suffix1

wb.SaveAs fName1, FileFormat:=xlOpenXMLWorkbookMacroEnabled

    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

            strbody = "font size=""3"" face=""Calibri"">" & _
                  "Hello :br B" & _
                  fName & "/B COR has been created.<br>" & _
                  "Click " & _
                  "A HREF=""file://" & fName1 & _
                  """HereA" & _
                  " to open the live file." & _
                  "brClick " & _
                  "A HREF ""file://" & fName2 & _
                  """Her</A>" & _
                  " to open the PO." & _
                  "<br><br>A copy of the COR has also been attached." & _
                  "<br><br><br>Regards," & _
                  "<br><br>Sales</font>"

    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "A New Change Order Report has been Entered for job " & Range("CORProjectNo")
        .HTMLBody = strbody
        .Attachments.Add fName1
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

Ok, I was able to come up with the following code which works "mostly", it did find the file in the inbox but not in any subfolders. I thought that the Inbox would include all subfolders as well but it looks like it will not. I need to be able to check in subfolders in case whoever is using this code has rules and subfolders where the attachment will be.

Sub GetAttachment()
 Dim ns As Namespace
 Dim Inbox As MAPIFolder
 Dim Item As Object
 Dim Atmt As Attachment
 Dim FileName As String
 
 Set ns = GetNamespace("MAPI")
 Set Inbox = ns.GetDefaultFolder(olFolderInbox)
 
  For Each Item In Inbox.Items
    For Each Atmt In Item.Attachments
        If Atmt.FileName = Range("CORPONo").Value Then
            FileName = Range("COFolder").Value & "\" & Atmt.FileName
            MsgBox FileName
            Atmt.SaveAsFile FileName
        Exit Sub
        End If
    Next Atmt
 Next Item
 
End Sub

So I have been working on this and was able to come up with the following code. It searches through the inbox and then through the subfolders. If anyone has a better or faster way that would be great. Next thing I want to do is find a way to search a specific folder, I think it would be better to run the code faster that way.

Sub GetAttachmentfromAllFolders()
    Dim olApp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim olFolder, Inbox As Outlook.MAPIFolder
    Dim eFolder As Outlook.Folder
    Dim Item As Object
    Dim Atmt As Outlook.Attachment
    Dim FileName As String
    
    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    For Each eFolder In olNs.GetDefaultFolder(olFolderInbox).Folders
        Set olFolder = olNs.GetDefaultFolder(olFolderInbox).Folders(eFolder.Name)
           For Each Item In Inbox.Items
                For Each Atmt In Item.Attachments
                    If Atmt.FileName = Range("CORPONo").Value Then
                        FileName = Range("COFolder").Value & "\" & Atmt.FileName
                        MsgBox FileName
                        Atmt.SaveAsFile FileName
                        Exit Sub
                    End If
                 Next Atmt
           Next Item
           For Each Item In olFolder.Items
                For Each Atmt In Item.Attachments
                    If Atmt.FileName = Range("CORPONo").Value Then
                        FileName = Range("COFolder").Value & "\" & Atmt.FileName
                        MsgBox FileName
                        Atmt.SaveAsFile FileName
                        Exit Sub
                    End If
                 Next Atmt
           Next Item
        Set olFolder = Nothing
    Next eFolder
End Sub

Does anyone have an idea of how I can search outlook subfolders for a specific folder then find the attachment. If the subfolder does not exist I want to then look for the attachment in the inbox and all subfolders.