Download attachment from Outlook and Open in Excel Download attachment from Outlook and Open in Excel vba vba

Download attachment from Outlook and Open in Excel


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 = 6Sub 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 sMsgEnd 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 attachmentConst 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 savingConst 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    NextEnd 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 = 6Sub 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


(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 ObjectDim olmapi As ObjectDim olmail As ObjectDim olitem As ObjectDim lrow As IntegerDim olattach As ObjectDim str As StringConst num As Integer = 6Const path As String = "C:\HP\"Const emailpath As String = "C:\Dell\"Const olFolderInbox As Integer = 6Set 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 olitemEnd IfActiveSheet.Rows.WrapText = FalseEnd Sub