Download attachment from Outlook and Open in Excel

Question

I'm trying to download and then open an Excel spreadsheet attachment in an Outlook email using VBA in Excel. How can I:

1. Download the one and only attachment from the first email (the newest email) in my Outlook inbox
2. Save the attachment in a file with a specified path (eg: "C:...")
3. Rename the attachment name with the: current date + previous file name
4. Save the email into a different folder with a path like "C:..."
5. Mark the email in Outlook as "read"
6. Open the excel attachment in Excel

I also want to be able to save the following as individual strings assigned to individual variables:

• Sender email Address
• Date received
• Date Sent
• Subject
• The message of the email

although this may be better to ask in a separate question / look for it myself.

The code I do have currently is from other forums online, and probably isn't very helpful. However, here are some bits and pieces I have been working on:

Sub SaveAttachments()     Dim olFolder As Outlook.MAPIFolder     Dim att As Outlook.Attachment     Dim strFilePath As String     Dim fsSaveFolder As String      fsSaveFolder = "C:\test\"      strFilePath = "C:\temp\"      Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)      For Each msg In olFolder.Items         While msg.Attachments.Count > 0             bflag = False             If Right$(msg.Attachments(1).Filename, 3) = "msg" Then                 bflag = True                 msg.Attachments(1).SaveAsFile strFilePath & strTmpMsg                 Set msg2 = Application.CreateItemFromTemplate(strFilePath & strTmpMsg)             End If             sSavePathFS = fsSaveFolder & msg2.Attachments(1).Filename       End If End Sub 

Answer 1

I can give you the complete code in one go but that wouldn't help you learn from it ;) So let's Break up your requests and then we will tackle them 1 by 1. This is gonna be a very long post so be patient :)

There are total 5 parts which will cover all 7 (yes 7 and not 6) points so you don't have to create a new question for your 7th point.

---

PART - 1

1. Creating a Connection to Outlook
2. Checking if there is any unread email
3. Retrieving details like Sender email Address, Date received, Date Sent, Subject, The message of the email

See this code example. I am latebinding with Outlook from Excel then checking if there are any unread items and if there are I am retrieving the relevant details.

Const olFolderInbox As Integer = 6  Sub ExtractFirstUnreadEmailDetails()     Dim oOlAp As Object, oOlns As Object, oOlInb As Object     Dim oOlItm As Object      '~~> Outlook Variables for email     Dim eSender As String, dtRecvd As String, dtSent As String     Dim sSubj As String, sMsg As String      '~~> Get Outlook instance     Set oOlAp = GetObject(, "Outlook.application")     Set oOlns = oOlAp.GetNamespace("MAPI")     Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)      '~~> Check if there are any actual unread emails     If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then         MsgBox "NO Unread Email In Inbox"         Exit Sub     End If      '~~> Store the relevant info in the variables     For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")         eSender = oOlItm.SenderEmailAddress         dtRecvd = oOlItm.ReceivedTime         dtSent = oOlItm.CreationTime         sSubj = oOlItm.Subject         sMsg = oOlItm.Body         Exit For     Next      Debug.Print eSender     Debug.Print dtRecvd     Debug.Print dtSent     Debug.Print sSubj     Debug.Print sMsg End Sub 

So that take care of your request which talks about storing details in the variables.

---

PART - 2

Now moving on to your next request

1. Download the one and only attachment from the first email (the newest email) in my Outlook inbox
2. Save the attachment in a file with a specified path (eg: "C:...")
3. Rename the attachment name with the: current date + previous file name

See this code example. I am again latebinding with Outlook from Excel then checking if there are any unread items and if there are I am further checking if it has an attachment and if it has then download it to the relevant folder.

Const olFolderInbox As Integer = 6 '~~> Path for the attachment Const AttachmentPath As String = "C:\"  Sub DownloadAttachmentFirstUnreadEmail()     Dim oOlAp As Object, oOlns As Object, oOlInb As Object     Dim oOlItm As Object, oOlAtch As Object      '~~> New File Name for the attachment     Dim NewFileName As String     NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"      '~~> Get Outlook instance     Set oOlAp = GetObject(, "Outlook.application")     Set oOlns = oOlAp.GetNamespace("MAPI")     Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)      '~~> Check if there are any actual unread emails     If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then         MsgBox "NO Unread Email In Inbox"         Exit Sub     End If      '~~> Extract the attachment from the 1st unread email     For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")         '~~> Check if the email actually has an attachment         If oOlItm.Attachments.Count <> 0 Then             For Each oOlAtch In oOlItm.Attachments                 '~~> Download the attachment                 oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename                 Exit For             Next         Else             MsgBox "The First item doesn't have an attachment"         End If         Exit For     Next  End Sub 

---

PART - 3

Moving on to your next request

1. Save the email into a different folder with a path like "C:..."

See this code example. This save the email to say C:\

Const olFolderInbox As Integer = 6 '~~> Path + Filename of the email for saving Const sEmail As String = "C:\ExportedEmail.msg"  Sub SaveFirstUnreadEmail()     Dim oOlAp As Object, oOlns As Object, oOlInb As Object     Dim oOlItm As Object, oOlAtch As Object      '~~> Get Outlook instance     Set oOlAp = GetObject(, "Outlook.application")     Set oOlns = oOlAp.GetNamespace("MAPI")     Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)      '~~> Check if there are any actual unread emails     If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then         MsgBox "NO Unread Email In Inbox"         Exit Sub     End If      '~~> Save the 1st unread email     For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")         oOlItm.SaveAs sEmail, 3         Exit For     Next End Sub 

---

PART - 4

Moving on to your next request

1. Mark the email in Outlook as "read"

See this code example. This will mark the email as read.

Const olFolderInbox As Integer = 6  Sub MarkAsUnread()     Dim oOlAp As Object, oOlns As Object, oOlInb As Object     Dim oOlItm As Object, oOlAtch As Object      '~~> Get Outlook instance     Set oOlAp = GetObject(, "Outlook.application")     Set oOlns = oOlAp.GetNamespace("MAPI")     Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)      '~~> Check if there are any actual unread emails     If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then         MsgBox "NO Unread Email In Inbox"         Exit Sub     End If      '~~> Mark 1st unread email as read     For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")         oOlItm.UnRead = False         DoEvents         oOlItm.Save         Exit For     Next  End Sub 

---

PART - 5

Moving on to your next request

1. Open the excel attachment in excel

once you have downloaded the file/attachment as shown above then use that path in the below code to open the file.

Sub OpenExcelFile()     Dim wb As Workbook      '~~> FilePath is the file that we earlier downloaded     Set wb = Workbooks.Open(FilePath) End Sub 

I converted this post into several blog posts (with more explanation) which can be accessed via points 15,16 and 17 in vba-excel

Answer 2

(Excel vba) 

Thanks to Sid :) for your code(stolen your code) .. i had this situation today .Here is my code .below code saves attachement,mail also mail information ..All credits goes to Sid

Tested   Sub mytry() Dim olapp As Object Dim olmapi As Object Dim olmail As Object Dim olitem As Object Dim lrow As Integer Dim olattach As Object Dim str As String  Const num As Integer = 6 Const path As String = "C:\HP\" Const emailpath As String = "C:\Dell\" Const olFolderInbox As Integer = 6  Set olp = CreateObject("outlook.application") Set olmapi = olp.getnamespace("MAPI") Set olmail = olmapi.getdefaultfolder(num)  If olmail.items.restrict("[UNREAD]=True").Count = 0 Then      MsgBox ("No Unread mails")      Else          For Each olitem In olmail.items.restrict("[UNREAD]=True")             lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1              Range("A" & lrow).Value = olitem.Subject             Range("B" & lrow).Value = olitem.senderemailaddress             Range("C" & lrow).Value = olitem.to             Range("D" & lrow).Value = olitem.cc             Range("E" & lrow).Value = olitem.body              If olitem.attachments.Count <> 0 Then                  For Each olattach In olitem.attachments                      olattach.SaveAsFile path & Format(Date, "MM-dd-yyyy") & olattach.Filename                  Next olattach              End If     str = olitem.Subject     str = Replace(str, "/", "-")     str = Replace(str, "|", "_")     Debug.Print str             olitem.SaveAs (emailpath & str & ".msg")             olitem.unread = False             DoEvents             olitem.Save         Next olitem  End If  ActiveSheet.Rows.WrapText = False  End Sub