Open attached excel file received in Outlook email

Question

I need help in an excel VBA code.I'm trying to open an Excel spreadsheet attachment in an Outlook email using VBA in Excel file. How can I do the following steps in Excel vba:

Open the outlook, go to "Inbox" sub folder "Test Reports".
Search the specific subject and sender on today's date or most recent date in unread emails.
Open the attachment or copy the data in the attachment excel file.
Activate the already open excel workbook. Name of the workbook is "Fed 10".
Copy the attachment data in the workbook "Fed 10" sheet "Analysis".
Close the attachment and mark the email as read.

I used the code mentioned in one of the post but it's not working as i want.

I have excel 2010, if anyone can help i'll be very thankful also if you describe the code step by step that will be terrific.

Thanks in advance

Code Mentioned below:

Const olFolderinbox As Integer = 6
'--> Path for the attachment
Const AttachmentPath As String = "C:\Test\"

Sub ExtractAttachmentFromEmail()
    Dim o01Ap As Object, oOlns As Object, o011nb As Object
    Dim o011tm 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 o011nb = 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 o011tm In oOlInb.Items.Restrict("[UnRead] = True")
        eSender = oOlItm.SenderEmailAddress
        dtRecvd = oOlItm.ReceivedTime
        dtSent = o011tm.CreationTime
        sSubj = oOlItm.Subject
        sMsg = oOlItm.Body
        Exit For
    Next

'--> New File Name for the attachment
    Dim NewFileName As String
    NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"

'--> Extract the attachment from the 1st unread email
    For Each o011tm In oOlInb.Items.Restrict("[UnRead] = True")

    '--> Check if the email actually has an attachment
    If oOlItm.Attachments.Count <> 0 Then
    For Each oOlAtch In o011tm.Attachments

    '--> Download the attachment
    o0lAtch.SaveAsFile NewFileName & o0lAtch.Filename
         Exit For
        Next
    Else
        MsgBox "The First item doesn;t have an attachment"
    End If
    Exit For

End Sub

Add Option Explicit at the top of the code module and fix your undeclared variables — Tim Williams
I wrote a code based on the post you mentioned but my requirement are slightly different that why i can't figure out the code. — N R

Alina Li Alina Li · Accepted Answer · 2018-10-15T07:40:53

At first, you could get all unread email in Inbox(according to you paste code)

Second, you could download excel and open it.

You could refer to this code:

    Public Sub saveAttachtoDisk(itm As Outlook.MailItem)

    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat, FilePath As String

    dateFormat = Format(Now, "yyyy-mm-dd H-mm")
    saveFolder = "c:\Users\abc1\Desktop" '<<EDIT removed trailing \
    For Each objAtt In itm.Attachments
      FilePath = saveFolder & "\" & dateFormat & _
                  " " & objAtt.DisplayName
      objAtt.SaveAsFile FilePath
      runit FilePath
    Next

End Sub

Sub runit(FilePath as String)
   Dim Shex As Object
   Set Shex = CreateObject("Shell.Application")
   Shex.Open (FilePath)
End Sub

'Edit: I used this to test the code, since I'm not running
'      it from a rule
Sub Tester()

    Dim Msg As MailItem

    Set Msg = Application.ActiveInspector.CurrentItem

    saveAttachtoDisk Msg

End Sub

For more information, you could refer to this link:

Code to download attachment from Outlook, save it on desktop and open it

Last, change unread email to read.

o011tm.UnRead = False

Open attached excel file received in Outlook email

1 Answers