PDA

View Full Version : [SOLVED] Save Attachments from Current Open Outlook Email



Poundland
10-23-2018, 03:43 AM
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
10-24-2018, 02:00 AM
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