Extract Body Text From Outlook Email To Excel

[needhelp2]

Hi, I wanna extract email body text from Outlook to excel and I am using my Gmail in outlook and all emails are available in Inbox folder moreover my subject is same in all emails but body text could be different and i got mentioned below code from search but not working. Please help me in this regard.Thankx in Advance.

sub ExtractBodySubjectFromMails()

Dim oNS As Outlook.Namespace
Dim oFld As Outlook.Folder
Dim oMails As Outlook.Items
Dim oMailItem As Outlook.MailItem
Dim oProp As Outlook.PropertyPage

Dim sSubject As String
Dim sBody

On Error GoTo Err_OL

Set oNS = Application.GetNamespace("MAPI")
Set oFld = oNS.GetDefaultFolder(olFolderInbox)
Set oMails = oFld.Items

For Each oMailItem In oMails
sBody = oMailItem.Body
sSubject = oMailItem.Subject 'This property corresponds to the MAPI property PR_SUBJECT. The Subject property is the default property for Outlook items.
Next

Exit Sub
Err_OL:
If Err <> 0 Then
MsgBox Err.Number & " - " & Err.Description
Err.Clear
Resume Next
End If
End Sub

 

[needhelp2]

Any suggestion?

 

[needhelp2]

here is picture of body text of email http://ge.tt/api/1/files/7pTVDDF1/0/blob?download

 

[Domenic]

First, since your code uses early binding, you'll need to make sure that you've set a reference to Outlook's object library...

VBA > Tools > References > select/check Microsoft Office Object Library > click OK

Secondly, you'll need to create an instance of Outlook..

Dim oApp as Object

Set oApp = CreateObject("Outlook.Application")

...and then you'll need to replace...

Set oNS = Application.GetNamespace("MAPI")

with

Set oNS = oApp.GetNamespace("MAPI")

Lastly, since your folder can contain an item other than 'MailItem", such as 'MeetingItem', you'll need to filter for 'MailItems' when looping through the items in your folder.

Try the following macro, which has been modified as follows...

1) it uses late binding, instead of early binding, so there's no need to set a reference

2) it filters the items in the folder for 'MailItems'

3) it places the extracted information in Column A and Column B of the active sheet, starting in the second row

Option Explicit

Sub ExtractBodySubjectFromMails()

    Dim oApp            As Object
    Dim oNS             As Object
    Dim oFld            As Object
    Dim oMail           As Variant
    
    Dim sSubject        As String
    Dim sBody           As String
    Dim Rw              As Long
        
    On Error GoTo ErrHandler
    
    Application.ScreenUpdating = False
    
    Set oApp = CreateObject("Outlook.Application")
    Set oNS = oApp.GetNamespace("MAPI")
    Set oFld = oNS.GetDefaultFolder(olFolderInbox)
    
    Rw = 2
    For Each oMail In oFld.Items
        If TypeName(oMail) = "MailItem" Then
            sSubject = oMail.Subject
            sBody = oMail.Body
            Cells(Rw, "A").Value = sSubject
            Cells(Rw, "B").Value = sBody
            Rw = Rw + 1
        End If
    Next oMail
    
    Columns("A:B").WrapText = False

FinishUp:
    Application.ScreenUpdating = True
    
    Exit Sub
    
ErrHandler:
    If Err <> 0 Then
        MsgBox Err.Number & " - " & Err.Description
    End If
    
    Resume FinishUp
    
End Sub

Hope this helps!

 

[needhelp2]

Hi thank you for your reply,

Its givinge me error when i am pressing F5 , "Variable Not Define"

All emails has same Subject called "Contact League" and are available in Folder "Inbox"

 

[needhelp2]

Here is my object setting in Tools :>> reference option

 

[Domenic]

Can you post the exact code that you're running?

 

[needhelp2]

Latest Status . . .

Now after selection of Miscrosoft outlook 14.0 object library, Is getting execute but i am getting nothing in my excel sheet nor it's seems busy cursor so that i could know either its progressing at back end

 

[needhelp2]

Can you post the exact code that you're running?

Option Explicit

Sub ExtractBodySubjectFromMails()

    Dim oApp            As Object
    Dim oNS             As Object
    Dim oFld            As Object
    Dim oMail           As Variant
    
    Dim sSubject        As String
    Dim sBody           As String
    Dim Rw              As Long
        
    On Error GoTo ErrHandler
    
    Application.ScreenUpdating = False
    
    Set oApp = CreateObject("Outlook.Application")
    Set oNS = oApp.GetNamespace("MAPI")
    Set oFld = oNS.GetDefaultFolder(olFolderInbox)
    
    Rw = 2
    For Each oMail In oFld.Items
        If TypeName(oMail) = "MailItem" Then
            sSubject = oMail.Subject
            sBody = oMail.Body
            Cells(Rw, "A").Value = sSubject
            Cells(Rw, "B").Value = sBody
            Rw = Rw + 1
        End If
    Next oMail
    
    Columns("A:B").WrapText = False

FinishUp:
    Application.ScreenUpdating = True
    
    Exit Sub
    
ErrHandler:
    If Err <> 0 Then
        MsgBox Err.Number & " - " & Err.Description
    End If
    
    Resume FinishUp
    
End Sub

 

[Domenic]

To address your first issue, since we're using late binding, we'll need to replace...

Set oFld = oNS.GetDefaultFolder(olFolderInbox)

with

Set oFld = oNS.GetDefaultFolder(6)

Note that there will be no need to set a reference to Outlook's object library.