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
- Creating a Connection to Outlook
- Checking if there is any unread email
- 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
- Download the one and only attachment from the first email (the newest email) in my Outlook inbox
- Save the attachment in a file with a specified path (eg: "C:...")
- 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
- 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
- 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
- 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 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