How to extract excel attachment from outlook email
 

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.

How to extract excel attachment from outlook email
 

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.