Outlook is popular email application to handle business emails. Thus, we use it for couple of hours to handle various email processing task in daily routine. Sometime, it is very time consuming to process certain emails received from specific sender or group. However, we can retrieve emails details to excel using a excel vba to code. Which can be very helpful to process such emails. Even, we can make a tracker while processing emails specifically processed for transaction kind of activities.
In this topic, we will see how to retrieve outlook emails detail from Inbox folder into excel workbook.
Before writing the macro add reference to outlook library as shown in below steps:
Step1:
Step2:
Now, we are ready to code below excel macro to retrieve outlook email details from Inbox folder.
Option Explicit
Sub Retrieve_Emails_From_Inbox()
' Author: Dreams24
' Written for VBA Tricks and tips blog
' https://vbatricksntips.com
'Declare Variables
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olMail As Outlook.MailItem
Dim i As Long
Dim olDate As Date
Dim shtName As String
Dim lRow As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.StatusBar = False
'Pass Sheet name where you want email details
shtName = "Sheet1"
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
'Pass date to variable for Received time
olDate = Date ' e.g. olDate = "10/01/2017"
ThisWorkbook.Sheets(shtName).Activate
Range("A1:D" & ActiveSheet.Rows.Count).Clear
Range("A1") = "Subject"
Range("B1") = "Received Time"
Range("C1") = "Sender Name"
Range("D1") = "Email Body"
Set olFolder = olNs.GetDefaultFolder(olFolderInbox)
'For loop to check email item for Received time(Date)
For i = olFolder.Items.Count To 1 Step -1
Application.StatusBar = "Processing email item (" & i & ")..."
If TypeOf olFolder.Items(i) Is MailItem Then
Set olMail = olFolder.Items(i)
'if condition to check Received time
If InStr(olMail.ReceivedTime, olDate) > 0 Then
'Variable to get last row count in activesheet
lRow = Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
'Pass values to column A, B, C and D in Activesheet
Range("A" & lRow + 1) = olMail.Subject
Range("B" & lRow + 1) = olMail.ReceivedTime
Range("C" & lRow + 1) = olMail.SenderName
Range("D" & lRow + 1) = olMail.Body
End If
End If
Next i
Set olFolder = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.StatusBar = True
MsgBox "All email retrieved for received date: " & olDate, vbInformation
End Sub