I'm wondering if possibly declaring TheEmail as Object rather than MailItem
would be helpful. Do you ever hit the error handler code? If you do it
could be because instantiating a MailItem object from a report item would
fire an exception.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm


"Chris" wrote in message
...
OK Ken,

It seems so close and yet so far away. I am doing the message class but
anytime it htis a delivery report or read receipt, I cannot get the
message
class. I have a check to add the category "Not Copied" (it exists in the
list) and it will change the category of the message prior to the receipt.
The message box never displays a "REPORT" message class just "IPM.NOTE"
and
the out of office one. I am including the code and am hoping a light will
shine on the error in the code. Thanks for your continued assistance.

Chris
-----CODE START-----
Dim TheEmail As Outlook.MailItem
Dim eItem As Outlook.Items
Dim EmailNS As NameSpace
Dim fldrCount, EmailPath2, NbrItem, myfolder
Dim strSubj, strTime, mailClassCheck, EmailPath As String
Dim NewFileName As String
Dim Cats
Dim CheckErr, Exists As Boolean

CheckErr = False
Set EmailNS = Application.GetNamespace("MAPI")
Set myfolder = Application.ActiveExplorer.CurrentFolder
NbrItem = myfolder.Items.Count
On Error GoTo Error_Handler

'EmailPath = InputBox("Enter the save folder location:", "Email Save
Path", CurDir)
EmailPath = "C:\users\CMPurdom\Desktop\Mail Burn\Tester\"
For i = 1 To NbrItem
Set TheEmail = Application.ActiveExplorer.CurrentFolder.Items.Ite m(i)
mailClassCheck = TheEmail.MessageClass
MsgBox mailClassCheck
If Right(mailClassCheck, 6) = "REPORT" Then
SaveMailAsFile TheEmail, olSaveAsMsg,
"C:\users\CMPurdom\Desktop\Mail Burn\Testers\"
GoTo Step1
End If
If TheEmail.Subject = "" Then strSubj = "no subject"

strSubj = Replace(TheEmail.Subject, "/", "-")
strSubj = Replace(strSubj, "\", "-")
strSubj = Replace(strSubj, ":", "--")
strSubj = Replace(strSubj, "?", sReplace)
strSubj = Replace(strSubj, Chr(34), sReplace)
strSubj = Replace(strSubj, "", sReplace)
strSubj = Replace(strSubj, "", sReplace)
strSubj = Replace(strSubj, "|", sReplace)
strTime = Replace(TheEmail.ReceivedTime, "/", "-")
strTime = Replace(strTime, "\", "-")
strTime = Replace(strTime, ":", ".")
strTime = Replace(strTime, "?", sReplace)
strTime = Replace(strTime, Chr(34), sReplace)
strTime = Replace(strTime, "", sReplace)
strTime = Replace(strTime, "", sReplace)
strTime = Replace(strTime, "|", sReplace)
'SaveMailAsFile TheEmail, olSaveAsMsg, "C:\users\CMPurdom\Desktop\Mail
Burn\Testers\"
NewFileName = TheEmail.SenderName & "_" & strTime & "_" & strSubj &
".msg"

If NewFileName "" Then
TheEmail.SaveAs EmailPath & NewFileName, olMSG
Else
MsgBox "No file name was entered. Operation aborted.", 64,
"Cancel Operation"
Exit Sub
End If
Step1:
Next i
GoTo Done

Error_Handler:
MsgBox TheEmail.MessageClass & Chr$(13) & TheEmail.Subject & Chr$(13) &
Err.Number & ": " & Err.Description
TheEmail.Categories = TheEmail.Categories & ";" & "Not Copied"
TheEmail.Save
Resume Next

Done:
End Sub
-----CODE END-----