Hi, I am writing to seek help as I would like to add the following functionalities to the code below but I am not sure how to go about doing so as I found this code from a sample application.

Additional logic:
-----------------
* Only extract attachments for the following formats: xls, xlsx & csv
* Extract attachment only with from yesterday sent date (emails).


Here is my current code which is currently not outputting anything:

Sub GetAttachments()

Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim myExt As String

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox).Folders("Offer" )
i = 0

If Inbox.Items.Count = 0 Then
MsgBox "There are no messages in the Inbox.", vbInformation, _
"Nothing Found"
Exit Sub
End If

For Each Item In Inbox.Items
For Each Atmt In Item.Attachments

Select Case myExt
Case "xls", "xlsm", "xlsx"

FileName = "C:\Users\missy\Desktop\Outlook_files\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
'Case Else
'do nothing
End Select
Next Atmt
Next Item

GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub

End Sub


Any further help or feedback would be very much appreciated. Many thanks for your time and help.

hi,

http://www.rondebruin.nl/win/s1/outlook/saveatt.htm

Sub SaveEmailAttachmentsToFolder(OutlookFolderInInbox As String, _
ExtString As String, DestFolder As String)

isabelle

Le 2015-08-17 04:58, a écrit :

Hi, I am writing to seek help as I would like to add the following
functionalities to the code below but I am not sure how to go about doing so
as I found this code from a sample application.

Additional logic: ----------------- * Only extract attachments for the
following formats: xls, xlsx & csv * Extract attachment only with from
yesterday sent date (emails).


Here is my current code which is currently not outputting anything:

Sub GetAttachments()

Dim ns As NameSpace Dim Inbox As MAPIFolder Dim Item As Object Dim Atmt As
Attachment Dim FileName As String Dim i As Integer Dim myExt As String

Set ns = GetNamespace("MAPI") Set Inbox =
ns.GetDefaultFolder(olFolderInbox).Folders("Offer" ) i = 0

If Inbox.Items.Count = 0 Then MsgBox "There are no messages in the Inbox.",
vbInformation, _ "Nothing Found" Exit Sub End If

For Each Item In Inbox.Items For Each Atmt In Item.Attachments

Select Case myExt Case "xls", "xlsm", "xlsx"

FileName = "C:\Users\missy\Desktop\Outlook_files\" & Atmt.FileName
Atmt.SaveAsFile FileName i = i + 1 'Case Else 'do nothing End Select Next
Atmt Next Item

GetAttachments_exit: Set Atmt = Nothing Set Item = Nothing Set ns = Nothing
Exit Sub

End Sub


Any further help or feedback would be very much appreciated. Many thanks for
your time and help.