Two suggested macros (not tested here) from this resource : https://stackoverflow.com/ques…ba-with-two-email-address
The first one is listed as an answer that works.
Code
Sub GetFromInbox()
Dim olapp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim Fldr As Outlook.MAPIFolder
Dim olMail As Outlook.MailItem
Dim Pst_Folder_Name As String, MailboxName As String
Dim i As Long
MailboxName = "[email protected]"
Pst_Folder_Name = "Inbox"
Set olapp = New Outlook.Application
Set olNs = olapp.GetNamespace("MAPI")
Set Fldr = olNs.Folders(MailboxName).Folders(Pst_Folder_Name)
With Sheets("sheet1")
.Cells.ClearContents
.Cells(1, 1).Value = "Date"
i = 2
For Each olMail In Fldr.Items
'For Each olMail In olapp.CurrentFolder.Items
.Cells(i, 1).Value = olMail.ReceivedTime
.Cells(i, 3).Value = olMail.Subject
.Cells(i, 4).Value = olMail.SenderName
i = i + 1
Next olMail
End With
olapp.Quit
Set olapp = Nothing
End Sub
Display More
Second macro :
Code
Option Explicit
Public Sub Example()
Dim Folder As MAPIFolder
Dim CurrentExplorer As Explorer
Dim Item As Object
Dim App As Outlook.Application
Dim Items As Outlook.Items
Dim LastRow As Long, i As Long
Dim xlStarted As Boolean
Dim Book As Workbook
Dim Sht As Worksheet
Set App = Outlook.Application
Set Folder = App.ActiveExplorer.CurrentFolder
Set Items = Folder.Items
Set Book = ActiveWorkbook
Set Sht = Book.Worksheets("Sheet1")
LastRow = Sht.Range("A" & Sht.Rows.Count).End(xlUp).Row
i = LastRow + 1
For Each Item In Items
If Item.Class = olMail Then
Sht.Cells(i, 1) = Item.ReceivedTime
Sht.Cells(i, 2) = Item.SenderName
Sht.Cells(i, 3) = Item.Subject
i = i + 1
Book.Save
End If
Next
Set Item = Nothing
Set Items = Nothing
Set Folder = Nothing
Set App = Nothing
End Sub
Display More