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.