If you want to import the details like Sender Name , Subject , Received Date , Mail Content of all unread emails from outlook to Excel
Sub Scan_my_outlook_inbox()
'TOOLS ->Refrence -> microsoft outlook
'declare outlook objects
Dim olapp As Outlook.Application
Dim olappns As Outlook.Namespace
Dim oinbox As Outlook.Folder
Dim oitem As Outlook.MailItem
Dim myItems As Outlook.Items
Dim i As Long
i = 2
'set outlook objects
Set olapp = New Outlook.Application
Set olappns = olapp.GetNamespace("MAPI")
' it will scan inbox folder only
Set oinbox = olappns.GetDefaultFolder(olFolderInbox)
' check if any unread email in inbox
If oinbox.Items.Restrict("[UnRead] = True").Count = 0 Then
MsgBox "NO Unread Email In Inbox"
Exit Sub
End If
' sort emails on recieved basis
Set myItems = oinbox.Items
myItems.Sort "[Received]", True
'loop through all unread emails
For Each oitem In myItems.Restrict("[UnRead] = True")
Sheets("Inbox Scan").Cells(i, 1).Value = oitem.SenderName
Sheets("Inbox Scan").Cells(i, 2).Value = oitem.SenderEmailAddress
Sheets("Inbox Scan").Cells(i, 3).Value = oitem.Subject
Sheets("Inbox Scan").Cells(i, 4).Value = oitem.Body
Sheets("Inbox Scan").Cells(i, 5).Value = oitem.ReceivedTime
i = i + 1
Next
End Sub
Code to Loop through all unread emails in any folder created by user of outlook and import the details to Excel .
For Example i have taken folder "My Gmail" in below code.
Sub Scan_my_outlook_folder()
'TOOLS ->Refrence -> microsoft outlook'declare outlook objects
Dim olapp As Outlook.ApplicationDim olappns As Outlook.NamespaceDim oinbox As Outlook.FolderDim oitem As Outlook.MailItemDim myItems As Outlook.ItemsDim i As Longi = 2'set outlook objectsSet olapp = New Outlook.ApplicationSet olappns = olapp.GetNamespace("MAPI")Set oinbox = olappns.GetDefaultFolder(olFolderInbox)' folder to scanSet oinbox = oinbox.Folders("My Gmail")
' check if any unread email in folder name " my gmail " If oinbox.Items.Restrict("[UnRead] = True").Count = 0 Then MsgBox "NO Unread Email In Inbox" Exit Sub End If
' sort emails on recieved basisSet myItems = oinbox.ItemsmyItems.Sort "[Received]", True
'loop through all unread emails
For Each oitem In myItems.Restrict("[UnRead] = True") Sheets("Specific Folder").Cells(i, 1).Value = oitem.SenderName Sheets("Specific Folder").Cells(i, 2).Value = oitem.SenderEmailAddress Sheets("Specific Folder").Cells(i, 3).Value = oitem.Subject 'Sheets("Specific Folder").Cells(i, 4).Value = oitem.Body Sheets("Specific Folder").Cells(i, 5).Value = oitem.ReceivedTime i = i + 1 Next
End SubCode to Loop through all unread emails in all folders in outlook and import the details to Excel .Dim oitem As Outlook.MailItemDim i As LongSub all_folder_scan()'Tools Reference Microsoft OutlookDim olapp As Outlook.ApplicationDim olappns As Outlook.NamespaceDim oinbox As Outlook.FolderDim oFolder As Outlook.MAPIFolderi = 2'tools->refrence->microsoft outlookSet olapp = New Outlook.ApplicationSet olappns = olapp.GetNamespace("MAPI")' set inbox folderSet oinbox = olappns.GetDefaultFolder(olFolderInbox) For Each oitem In oinbox.Items.Restrict("[UnRead] = True") Sheets("All Folders Scan").Cells(i, 5).Value = oitem.Subject Sheets("All Folders Scan").Cells(i, 4).Value = oitem.SenderEmailAddress Sheets("All Folders Scan").Cells(i, 3).Value = oitem.SenderName Sheets("All Folders Scan").Cells(i, 6).Value = oitem.Body Sheets("All Folders Scan").Cells(i, 7).Value = oitem.ReceivedTime Sheets("All Folders Scan").Cells(i, 2).Value = oinbox.Name Sheets("All Folders Scan").Cells(i, 1).Value = oinbox.FolderPath i = i + 1 Next For Each oFolder In oinbox.Folders Call subfolders_go(oFolder) NextEnd SubPrivate Sub subfolders_go(oParent As Outlook.Folder)Dim oFolder1 As Outlook.MAPIFolder For Each oitem In oParent.Items.Restrict("[UnRead] = True") Sheets("All Folders Scan").Cells(i, 5).Value = oitem.Subject Sheets("All Folders Scan").Cells(i, 4).Value = oitem.SenderEmailAddress Sheets("All Folders Scan").Cells(i, 3).Value = oitem.SenderName Sheets("All Folders Scan").Cells(i, 6).Value = oitem.Body Sheets("All Folders Scan").Cells(i, 7).Value = oitem.ReceivedTime Sheets("All Folders Scan").Cells(i, 2).Value = oParent.Name Sheets("All Folders Scan").Cells(i, 1).Value = oParent.FolderPath i = i + 1 Next If (oParent.Folders.Count > 0) Then For Each oFolder1 In oParent.Folders Call subfolders_go(oFolder1) Next End IfEnd Sub 
