Save Attachments from Current Open Outlook Email

[Poundland]

Hi Guys,

I'm having a Brain ache trying to figure this out..

I have the below code that searches through my Inbox and saves attachments from all emails that meeting the restricted criteria, this works fine.

What I am having trouble with is trying to adapt the code so that it only saves attachments from the urrent open email. Any help on this would be greatly appreciated.

Sub Find_and_Save() ' finds email, saves attachment
     
    Dim olMail As Object, olAtt As Object, pdat As Date
    Dim strSaveToFolder As String, strPathAndFilename As String, Monday As String, prevpdat As String
   
     pdat = Format(Now, "dd/mm/yyyy")
 
        prevpdat = Format(pdat - 1, "ddddd") & " 23:59"
strSaveToFolder = "P:\H925 Buying\Data Trading Administration forms\Temp Folder\"
    On Error GoTo errorhandler
    With CreateObject("Outlook.Application").GetNamespace("MAPI")
   For Each olMail In .GetDefaultFolder(6).Items.Restrict("[ReceivedTime] > '" & prevpdat & "'")
         
                If olMail.Attachments.Count > 0 Then
                    For Each olAtt In olMail.Attachments
                    Application.DisplayAlerts = False
                        strPathAndFilename = strSaveToFolder & Format(pdat, "dd.mm.yyyy") & " " & olAtt.Filename
                            
                            olAtt.SaveAsFile strPathAndFilename
                            olMail.Save
                            Application.DisplayAlerts = True
                    Next olAtt
                End If
       Next
              On Error GoTo 0
    End With
errorhandler:
     
End Sub

[Poundland]

This has now been solved, workable code below. Tested on Excel 2016 32bit

Sub Find_and_Save() ' finds email, saves attachment
     
    Dim olAtt As Object
    Dim strSaveToFolder As String, strPathAndFilename As String
   Dim a As Object
     
strSaveToFolder = "P:\H925 Buying\Data Trading Administration forms\Temp Folder\"
   
    For Each olAtt In CreateObject("Outlook.Application").activeinspector.currentitem.attachments
        MsgBox olAtt.DisplayName
        strPathAndFilename = strSaveToFolder & olAtt.Filename
        Application.DisplayAlerts = False
        olAtt.SaveAsFile strPathAndFilename
        Application.DisplayAlerts = True
    Next
End Sub