Open email by attachment name

[Mylarbi]

Hi, I am trying to get a macro that
1. Searches for and based on file name of Excel attachment.
2. The file name is the value of the active cell.
2. Opens the email found.
3. Saves and Opens the Excel attachment.
4. Closes the email.

I have put the following code together but it doesn't work as expected. Thanks in advance.

Sub Search_Email_Open()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim strTempFilePath As String
Dim sFileName As String
Dim atchName As String
Dim i As Integer

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("Reports")
atchName = ActiveCell.Value
i = 1

For Each olMail In Fldr.Items
If atchName = sFileName Then
olMail.Display

sFileName = olMail.Attachments.Item(1).DisplayName
    strTempFilePath = "C:\Users\User1\Documents\"
    olMail.Attachments(1).SaveAsFile sFileName
    olMail.Close olSave
    Workbooks.Open strTempFilePath & sFileName
i = i + 1
End If

Next olMail
End Sub