How to copy email info to Excel? - excel

Question

I have the following code to get email info from a specific sender. I cannot manage to copy the info to Excel.
I can see the info in the immediate window but nothing else.
Sub Getemaildetails()
Dim ol As Outlook.Application
Dim ns As Outlook.Namespace
Dim fol As Outlook.Folder
Dim i As Object
Dim mi As Outlook.MailItem
Dim Filtertext As String
Set ol = New Outlook.Application
Set ns = ol.GetNamespace("Mapi")
Set fol = ns.GetDefaultFolder(olFolderInbox)
Filtertext = "[SenderName]= 'Eskalem Bogale'"
Set i = fol.Items.Find(Filtertext)
Range("A2", Range("A2").End(xlDown).End(xlToRight)).Clear
If i Is Nothing Then
MsgBox "Nothing was found.", vbExclamation
Exit Sub
End If
If i.Class <> olMail Then
MsgBox "Item is not an email.", vbExclamation
Exit Sub
End If
Set mi = i
Debug.Print mi.Subject
End Sub

Answer 1

Since you do not try clarifying my clarification question, I only assumes that I correctly understood what you need. Meaning to return date from all received emails from that specific sender. It should be very fast, placing the data in an array and then dropping the processing result at once:
Sub GetEmaildetails()
Dim ol As Outlook.Application, ns As Outlook.NameSpace
Dim fol As Outlook.folder, i As Outlook.items, arrM
Dim mi As Outlook.MailItem, Filtertext As String, iEm As Long
Set ol = New Outlook.Application
Set ns = ol.GetNamespace("Mapi")
Set fol = ns.GetDefaultFolder(olFolderInbox)
Filtertext = "[SenderName]= 'Eskalem Bogale'"
'You can also use:
'Filtertext = "[From] = 'Eskalem Bogale'"
Set i = fol.items.Restrict(Filtertext)
Range("A2", Range("A2").End(xlDown).End(xlToRight)).Clear
If i Is Nothing Then
MsgBox "Nothing was found.", vbExclamation
Exit Sub
End If
ReDim arrM(1 To i.count + 1, 1 To 3)
iEm = 2
For Each mi In i
arrM(iEm, 1) = mi.Subject
arrM(iEm, 2) = mi.ReceivedTime
arrM(iEm, 3) = mi.size
iEm = iEm + 1
'it can also return Body, Catetories...
Next
Range("A2").Resize(UBound(arrM), 3).Value = arrM
MsgBox "Ready..."
End Sub