Passing Outlook mail body to string - vba

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

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

Answer 2

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.