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
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