Extract a table from the email body in excel VBA Code

Viewed 805

Well, I am very new to this VBA Code. I have found code to extract the email details in excel. This code is working for me the way I want but the only issue is the result that I am getting in excel for the Email Body. I have a table with relevant details in the email and I want the output in the same way in excel too for each individual emails.

Here is the code.


Sub GetFromOutlook()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Personal")

i = 1

For Each OutlookMail In Folder.Items
    If OutlookMail.ReceivedTime >= Range("From_date").Value Then
        Range("eMail_subject").Offset(i, 0).Value = OutlookMail.Subject
        Range("eMail_date").Offset(i, 0).Value = OutlookMail.ReceivedTime
        Range("eMail_sender").Offset(i, 0).Value = OutlookMail.SenderName
        Range("eMail_text").Offset(i, 0).Value = OutlookMail.Body        
        i = i + 1
    End If
Next OutlookMail

Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub

Below is a sample of the email body content.

Sample of Email Body image

Currently, the result from the query is - The body message of the email is getting pasted in one particular cell.

Can someone please help

1 Answers

I might be wrong, but it looks like your offsets aren't changing for each of the pieces of data. The offset is based on the current cell. If you write something into an offset (i,0) and then do the same again you will effectively be writing over the top of the initial data. This is why you end up with only the email text, because that's the last write operation.

Related