how to download attachment from outlook to PC

[emmr]

how i can download attachment (either XL, or Doc, or jpg, depend on requirement) from outlook to PC for a specific date, like 3.8.19 from inbox or subfolder, how?
TIA

[gmayor]

At its simplest, select the message and run the following:


Option Explicit

Sub ProcessMsg()
Dim olMsg As MailItem
On Error Resume Next
Set olMsg = ActiveExplorer.Selection.Item(1)
CustomSaveAttachments olMsg
lbl_Exit:
Exit Sub
End Sub


Sub CustomSaveAttachments(Item As Outlook.MailItem)
Const strPath As String = "D:\My Documents\Test\Outlook Attachments\" 'must exist
Const oDate As Date = "03/08/2019"
Dim olAtt As Attachment
Dim strFileName As String
If Not Format(Item.ReceivedTime, "yyyymmdd") = Format(oDate, "yyyymmdd") Then GoTo lbl_Exit
If Item.Attachments.Count > 0 Then
For Each olAtt In Item.Attachments
If Mid(UCase(olAtt.fileName), InStrRev(olAtt.fileName, Chr(46))) Like ".XL*" Or _
Mid(UCase(olAtt.fileName), InStrRev(olAtt.fileName, Chr(46))) Like ".DOC*" Or _
Mid(UCase(olAtt.fileName), InStrRev(olAtt.fileName, Chr(46))) Like ".JPG" Then
strFileName = olAtt.fileName
olAtt.SaveAsFile strPath & strFileName
End If
Next olAtt
End If
lbl_Exit:
Set olAtt = Nothing
Exit Sub
End Sub