Passing Outlook mail body to string

Question

I'm trying to gather email addresses from bad responses to an email blast.

The code is split into two parts, the search part, which searches for a character in the email and returns the string before and after it, and the process part, which runs the search on every email in an Outlook folder.

I've tested the search on emails that I've copied into Excel and it works.

The issue I'm having is I can't pass the email body, which is an object, to a string variable.

Sub Extract()
On Error Resume Next

'specify the folder to pull emails from
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Set myfolder = myOlApp.ActiveExplorer.CurrentFolder
Dim myitem As Outlook.MailItem

'start excel and open spreadsheet
Set xlobj = CreateObject("excel.application")
xlobj.Visible = True
xlobj.Workbooks.Add

'Set Heading on spreadsheet
xlobj.Range("a" & 1).Value = "Email"

'for loop passing email body to search code
For i = 1 To myfolder.Items.Count
Set myitem = myfolder.Items(i)
extractStr = myitem.Body

'search for specific text
CheckStr = "[A-Za-z0-9._-]"
OutStr = ""
Index = 1
Index1 = VBA.InStr(Index, extractStr, "@")
getStr = ""
If Index1 > 0 Then
    For p = Index1 - 1 To 1 Step -1
        If Mid(extractStr, p, 1) Like CheckStr Then
            getStr = Mid(extractStr, p, 1) & getStr
        Else
            Exit For
        End If
    Next
    getStr = getStr & "@"
    For p = Index1 + 1 To Len(extractStr)
        If Mid(extractStr, p, 1) Like CheckStr Then
            getStr = getStr & Mid(extractStr, p, 1)
        Else
            Exit For
        End If
    Next
    Index = Index1 + 1
    If OutStr = "" Then
        OutStr = getStr
    Else
        OutStr = OutStr & Chr(10) & getStr
    End If
Else
    GoTo 20
End If


'write to excel
20 xlobj.Range("a" & i + 1).Value = OutStr

Next
End Sub

Update: I think I've got it figured out. To test this script I place one or two of the emails to pull email addresses from into a test folder. The emails I selected were html formatted! I put the following line of code to convert the current email body (myitem) to plain text.

myitem.BodyFormat = olFormatPlain

I've declared the myitem variable as both an object and a mailitem. When I run the script with myitem as an object I get an "object doesn't support this property or method" error at the following line:

myitem.BodyFormat = olFormatPlain

However, when I run it as a mail item I get a type mismatch error at this line:

For Each myitem In myfolder

Here's how I'm declaring the myitem variable in the two different scenarios:

Dim myitem as MailItem
Dim myitem as Object

Here's my updated code.

Option Explicit
Sub Extract()
'On Error Resume Next

'Variable declaration
Dim myOlApp As Outlook.Application
Dim mynamespace As Outlook.NameSpace
Dim myfolder As Selection
Dim myitem As MailItem
Dim i As Integer
Dim extractStr As String
Dim CheckStr As String
Dim OutStr As String
Dim Index As Integer
Dim Index1 As Integer
Dim getStr As String
Dim p As Integer

'start excel and open spreadsheet
Dim xlobj As Object
Set xlobj = CreateObject("excel.application")
xlobj.Visible = True
xlobj.Workbooks.Add

'Set Heading on spreadsheet
xlobj.Range("a" & 1).Value = "Email"

'Set reference to the Selection.
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Set myfolder = ActiveExplorer.Selection

'for loop passing email body to search code
For Each myitem In myfolder
    myitem.BodyFormat = olFormatPlain
    extractStr = myitem.Body
    MsgBox (extractStr)

'search for specific text
    CheckStr = "[A-Za-z0-9._-]"
    OutStr = ""
    Index = 1
    Index1 = VBA.InStr(Index, extractStr, "@")
    getStr = ""
    If Index1 > 0 Then
        For p = Index1 - 1 To 1 Step -1
            If Mid(extractStr, p, 1) Like CheckStr Then
                getStr = Mid(extractStr, p, 1) & getStr
            Else
                Exit For
            End If
        Next
        getStr = getStr & "@"
        For p = Index1 + 1 To Len(extractStr)
            If Mid(extractStr, p, 1) Like CheckStr Then
                getStr = getStr & Mid(extractStr, p, 1)
            Else
                Exit For
            End If
        Next
        Index = Index1 + 1
        If OutStr = "" Then
            OutStr = getStr
        Else
            OutStr = OutStr & Chr(10) & getStr
        End If
    Else
        GoTo 20
    End If


'write to excel
20     xlobj.Range("a" & i + 1).Value = OutStr

Next
End Sub

Answer 1

The standard method is to declare as Object, not a specific data type, then check that the item is that data type using Class or Typename.

When is a MailItem not a MailItem?

Option Explicit
Sub Extract()

'Variable declaration
Dim myOlApp As Outlook.Application
Dim mynamespace As Outlook.NameSpace
Dim myfolder As Selection
'Dim myitem As MailItem
Dim myitem As Object

Dim extractStr As String

'Set reference to the Selection.
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Set myfolder = ActiveExplorer.Selection

'for loop passing email body to search code

For Each myitem In myfolder

    if myitem.class = olmail then
        myitem.BodyFormat = olFormatPlain
        extractStr = myitem.Body
        MsgBox extractStr
    else
        extractStr = myitem.Body
        Msgbox "Not a mailitem " & extractStr
    end if

Next

End Sub

The ReportItem object is similar to a MailItem object, and it contains a report (usually the non-delivery report).

Note a Reportitem has no BodyFormat property.

Answer 2

I had two issues I needed to address. The first was selecting the correct folder for which to pull emails. Because I was using subfolders within the default folders I needed to declare each individually, similar to how you would move between folders in a Linux system.

'Set reference to the Selection.
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Set myfolder = mynamespace.GetDefaultFolder(olFolderInbox)
Set myfolder = myfolder.Folders.Item("2/19 Training Email Blast")
Set myfolder = myfolder.Folders.Item("bad emails")

The second issue was passing my email body to a string variable. When I did it the body text would be converted to something I didn't recognize. I used the StrConv function to convert it back to unicode.

extractStr = StrConv(myitem.Body, vbUnicode)

The last thing I have to do is clean it up a bit. Thanks to @niton I'll be able to parse the emails that are actually reports and those that are mailitems to handle them differently.

Thanks to everyone who commented and provided answers!

Here's a copy of the entire code:

Option Explicit
Sub Extract()
On Error Resume Next

'Variable declaration
Dim myOlApp As Outlook.Application
Dim mynamespace As Outlook.NameSpace
Dim myfolder As Object
Dim myitem As Object
Dim i As Integer
Dim extractStr As String
Dim CheckStr As String
Dim OutStr As String
Dim Index As Integer
Dim Index1 As Integer
Dim getStr As String
Dim p As Integer
Dim xlobj As Object

'start excel and open spreadsheet
Set xlobj = CreateObject("excel.application")
xlobj.Visible = True
xlobj.Workbooks.Add

'Set Heading on spreadsheet
xlobj.Range("a" & 1).Value = "Email"

'Set reference to the Selection.
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Set myfolder = mynamespace.GetDefaultFolder(olFolderInbox)
Set myfolder = myfolder.Folders.Item("2/19 Training Email Blast")
Set myfolder = myfolder.Folders.Item("bad emails")

'for loop passing email body to search code
For i = 1 To myfolder.Items.Count
    Set myitem = myfolder.Items(i)
    extractStr = StrConv(myitem.Body, vbUnicode)
    myitem.Body = extractStr

'search for specific text
    CheckStr = "[A-Za-z0-9._-]"
    OutStr = ""
    Index = 1
    Index1 = InStr(Index, extractStr, "@")

    getStr = ""
    If Index1 > 0 Then
        For p = Index1 - 1 To 1 Step -1
            If Mid(extractStr, p, 1) Like CheckStr Then
                getStr = Mid(extractStr, p, 1) & getStr
            Else
                Exit For
            End If
        Next
        getStr = getStr & "@"
        For p = Index1 + 1 To Len(extractStr)
            If Mid(extractStr, p, 1) Like CheckStr Then
                getStr = getStr & Mid(extractStr, p, 1)
            Else
                Exit For
            End If
        Next
        Index = Index1 + 1
        If OutStr = "" Then
            OutStr = getStr
        Else
            OutStr = OutStr & Chr(10) & getStr
        End If
    Else
        GoTo 20
    End If


'write to excel
20     xlobj.Range("a" & i + 1).Value = OutStr

Next
End Sub