If you want to run a loop through all the emails in your outlook inbox and import the information like subject, receive date, body,etc to excel. Try this macro
Option Explicit
Sub sample_macro()
'reference -> microsoft outlook
Dim oitem As Outlook.MailItem
Dim ol As Outlook.Application
Dim olns As Outlook.Namespace
Dim oinbox As Outlook.Folder
Dim j As Long
ThisWorkbook.Sheets(1).Range("a2:d" & ThisWorkbook.Sheets(1).Range("a1048576").End(xlUp).Row + 1).Clear 'clear existing data if any
Set ol = New Outlook.Application
Set olns = ol.GetNamespace("MAPI")
Set oinbox = olns.GetDefaultFolder(olFolderInbox) 'select the inbox
Set oinbox = oinbox.Folders("Ashish Koul") ' select if you want to choose any specific folder
oinbox.Items.Sort "[ReceivedTime]", True
j = 2
For Each oitem In oinbox.Items ' loop outlook emails
ThisWorkbook.Sheets(1).Range("a" & j).Value = oitem.SenderName
ThisWorkbook.Sheets(1).Range("b" & j).Value = oitem.Subject
ThisWorkbook.Sheets(1).Range("c" & j).Value = oitem.ReceivedTime
ThisWorkbook.Sheets(1).Range("d" & j).Value = oitem.Body
j = j + 1
Next
Set oinbox = Nothing
Set olns = Nothing
Set ol = Nothing
End Sub
Option Explicit
Sub sample_macro()
'reference -> microsoft outlook
Dim oitem As Outlook.MailItem
Dim ol As Outlook.Application
Dim olns As Outlook.Namespace
Dim oinbox As Outlook.Folder
Dim j As Long
ThisWorkbook.Sheets(1).Range("a2:d" & ThisWorkbook.Sheets(1).Range("a1048576").End(xlUp).Row + 1).Clear 'clear existing data if any
Set ol = New Outlook.Application
Set olns = ol.GetNamespace("MAPI")
Set oinbox = olns.GetDefaultFolder(olFolderInbox) 'select the inbox
Set oinbox = oinbox.Folders("Ashish Koul") ' select if you want to choose any specific folder
oinbox.Items.Sort "[ReceivedTime]", True
j = 2
For Each oitem In oinbox.Items ' loop outlook emails
ThisWorkbook.Sheets(1).Range("a" & j).Value = oitem.SenderName
ThisWorkbook.Sheets(1).Range("b" & j).Value = oitem.Subject
ThisWorkbook.Sheets(1).Range("c" & j).Value = oitem.ReceivedTime
ThisWorkbook.Sheets(1).Range("d" & j).Value = oitem.Body
j = j + 1
Next
Set oinbox = Nothing
Set olns = Nothing
Set ol = Nothing
End Sub
No comments:
Post a Comment