CODEWITHSUNDEEP
excelvbaoutlook
Raul Gonzales
Raul Gonzales

Reputation: 906

Copy the body of an email into Excel using VBA

I want to select the body of a specific email, copy it and paste it into Outlook.

I know that it would be easier to just press Ctrl + A and then Ctrl + C in the spreadsheet but this is part of a much larger process that involves automation of a report.

Sub GetFromInbox()
     
    Dim olApp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim olFldr As Outlook.MAPIFolder
    Dim olItms As Outlook.Items
    Dim olMail As Variant
    Dim i As Long
     
    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace(”MAPI”)
    Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
    Set olItms = olFldr.Items
     
    olItms.Sort “Subject”
     
    i = 1
     
    For Each olMail In olItms
        If InStr(olMail.Subject, “Criteria") > 0 Then
            ThisWorkbook.Sheets("YourSheet").Cells(i, 1).Value = outMail.Body
            i = i + 1
        End If
    Next olMail
     
    Set olFldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing
     
End Sub

I get a syntax error on:

If InStr(olMail.Subject, “Criteria") > 0 Then

Upvotes: 1

Views: 5747

Answers (1)

RyanL
RyanL

Reputation: 1276

I'd look at two things. First, is the sheet you want to paste the mail body to actually called "YourSheet" and secondly, you're referencing outMail.Body where outMail has never been dimensioned or set. Try this (assuming the sheet to paste to is called "Sheet1").

Sub GetFromInbox()

Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFldr As Outlook.MAPIFolder
Dim olItms As Outlook.Items
Dim olMail As Variant
Dim i As Long

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Set olItms = olFldr.Items

olItms.Sort "Subject"

i = 1

For Each olMail In olItms
    If InStr(1, olMail.Subject, "Criteria") > 0 Then
        ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Value = olMail.Body
        i = i + 1
    End If
Next olMail

Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing

End Sub

Upvotes: 1

Related Questions