MailItem.SaveAs not working

[Chris]

I am trying to save messages as a MSG format. I checked on the forum and

found the code but when I save, the file name is not completely written and

the file size is 0 bytes. Right now the code is only for the open message.

Ideally, I would like the code to be run on an Outlook folder. I am

operating in a Vista Enterprise environment. Any help would be greatly

appreciated.

-----VBA Code---
Sub SaveAsTXT()

Dim myItem As Outlook.Inspector

Dim objItem As Object

Dim strname As String

Set myItem = Application.ActiveInspector

If Not TypeName(myItem) = "Nothing" Then

Set objItem = myItem.CurrentItem

strname = "U:\E-Mail\" & objItem.SenderName & " " & objItem.Subject

& objItem.Sent & ".msg"

MsgBox strname

'Prompt the user for confirmation

Dim strPrompt As String

strPrompt = "Are you sure you want to save the item? " & _

"If a file with the same name already exists, " & _

"it will be overwritten with this copy of the file."

If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then

objItem.SaveAs strname, olMSGUnicode

End If

Else

MsgBox "There is no current active inspector."

End If

End Sub

-----End of VBA Code-----

 

[Ken Slovak - [MVP - Outlook]]

See if the file name you end up with has any illegal characters in it. See

if you can save the same item yourself manually, to see if that works.

"Chris" <Chris> wrote in message

news:C7994A49-C95B-4D0F-BF02-A2AEB97EBA13@microsoft.com...
> I am trying to save messages as a MSG format. I checked on the forum and
> found the code but when I save, the file name is not completely written
> and
> the file size is 0 bytes. Right now the code is only for the open
> message.
> Ideally, I would like the code to be run on an Outlook folder. I am
> operating in a Vista Enterprise environment. Any help would be greatly
> appreciated.

> -----VBA Code---> Sub SaveAsTXT()
> Dim myItem As Outlook.Inspector
> Dim objItem As Object
> Dim strname As String

> Set myItem = Application.ActiveInspector
> If Not TypeName(myItem) = "Nothing" Then
> Set objItem = myItem.CurrentItem

> strname = "U:\E-Mail\" & objItem.SenderName & " " & objItem.Subject
> & objItem.Sent & ".msg"
> MsgBox strname
> 'Prompt the user for confirmation
> Dim strPrompt As String
> strPrompt = "Are you sure you want to save the item? " & _
> "If a file with the same name already exists, " & _
> "it will be overwritten with this copy of the file."
> If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
> objItem.SaveAs strname, olMSGUnicode
> End If
> Else
> MsgBox "There is no current active inspector."
> End If
> End Sub
> -----End of VBA Code-----

 

[Chris]

Ken,

That partially solved the problem as it was adding an additional path to the

name which had illegal characters. However, it seems to be missing items

such as read receipts, meeting requests and responses, and tasks. Is there a

way to check for these items and then make the filename based on those

available fields? My thought is to do a Select Case TheEmail.Class but I

don't know if this will work and what fields are availble to create a name.

Right now, messages are created by SenderName, a scrubbed subject, and a

scrubbed received date. I would assume that I have to scrub any of the

fields in the other item types.

Thanks for assisting.
wrote:


> See if the file name you end up with has any illegal characters in it. See
> if you can save the same item yourself manually, to see if that works.

> >

>

> "Chris" <Chris> wrote in message
> news:C7994A49-C95B-4D0F-BF02-A2AEB97EBA13@microsoft.com...
> >I am trying to save messages as a MSG format. I checked on the forum and
> > found the code but when I save, the file name is not completely written
> > and
> > the file size is 0 bytes. Right now the code is only for the open
> > message.
> > Ideally, I would like the code to be run on an Outlook folder. I am
> > operating in a Vista Enterprise environment. Any help would be greatly
> > appreciated.
> > -----VBA Code---> > Sub SaveAsTXT()
> > Dim myItem As Outlook.Inspector
> > Dim objItem As Object
> > Dim strname As String
> > Set myItem = Application.ActiveInspector
> > If Not TypeName(myItem) = "Nothing" Then
> > Set objItem = myItem.CurrentItem
> > strname = "U:\E-Mail\" & objItem.SenderName & " " & objItem.Subject
> > & objItem.Sent & ".msg"
> > MsgBox strname
> > 'Prompt the user for confirmation
> > Dim strPrompt As String
> > strPrompt = "Are you sure you want to save the item? " & _
> > "If a file with the same name already exists, " & _
> > "it will be overwritten with this copy of the file."
> > If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
> > objItem.SaveAs strname, olMSGUnicode
> > End If
> > Else
> > MsgBox "There is no current active inspector."
> > End If
> > End Sub
> > -----End of VBA Code-----

> .
>

 

[Ken Slovak - [MVP - Outlook]]

Many of those "missing things" would not be available in a saved out MSG

file. You can certainly get any fields you want from a mail item to provide

a naming scheme, but in all cases you will want to make sure there are no

illegal characters in the resulting file name. These days you don't need to

worry about things like making your file name an 8.3 format, but illegal

characters are always a concern.

"Chris" <Chris> wrote in message

news:98EAE2C1-34A6-4753-882E-CEED4F7E0246@microsoft.com...
> Ken,

> That partially solved the problem as it was adding an additional path to
> the
> name which had illegal characters. However, it seems to be missing items
> such as read receipts, meeting requests and responses, and tasks. Is
> there a
> way to check for these items and then make the filename based on those
> available fields? My thought is to do a Select Case TheEmail.Class but I
> don't know if this will work and what fields are availble to create a
> name.
> Right now, messages are created by SenderName, a scrubbed subject, and a
> scrubbed received date. I would assume that I have to scrub any of the
> fields in the other item types.

> Thanks for assisting.

 

[Chris]

Ken,

Is there a way to save the delivery and read receipts and meeting request

acceptances/declines?

I looked at the Class of the delivery receipt and it came up the same as a

message. There is no ol equivalent for a read or delivery receipt but there

is for meeting requests.

I need to be able to copy everything in a folder to a .msg format. My code

works on messages perfectly but not on those items mentioned. I did scrub

the information and it still would not save. PLEASE HELP!!!!!

Chris
wrote:


> Many of those "missing things" would not be available in a saved out MSG
> file. You can certainly get any fields you want from a mail item to provide
> a naming scheme, but in all cases you will want to make sure there are no
> illegal characters in the resulting file name. These days you don't need to
> worry about things like making your file name an 8.3 format, but illegal
> characters are always a concern.

> >

>

> "Chris" <Chris> wrote in message
> news:98EAE2C1-34A6-4753-882E-CEED4F7E0246@microsoft.com...
> > Ken,
> > That partially solved the problem as it was adding an additional path to
> > the
> > name which had illegal characters. However, it seems to be missing items
> > such as read receipts, meeting requests and responses, and tasks. Is
> > there a
> > way to check for these items and then make the filename based on those
> > available fields? My thought is to do a Select Case TheEmail.Class but I
> > don't know if this will work and what fields are availble to create a
> > name.
> > Right now, messages are created by SenderName, a scrubbed subject, and a
> > scrubbed received date. I would assume that I have to scrub any of the
> > fields in the other item types.
> > Thanks for assisting.

> .
>

 

[Ken Slovak - [MVP - Outlook]]

I'm not sure what you're talking about.

Delivery reports for example have a MessageClass of "REPORT.IPM.Note.DR".

That's not an email MessageClass.

You would instantiate any item where the MessageClass starts with "REPORT"

as a ReportItem, with which you should be able to use SaveAs().

Most recipients won't allow delivery of either types of reports, but where

you do get them back that's what you'd do.

"Chris" <Chris> wrote in message

news:CB8A7BEA-8D3F-4E0B-972C-A746527770DC@microsoft.com...
> Ken,

> Is there a way to save the delivery and read receipts and meeting request
> acceptances/declines?

> I looked at the Class of the delivery receipt and it came up the same as a
> message. There is no ol equivalent for a read or delivery receipt but
> there
> is for meeting requests.

> I need to be able to copy everything in a folder to a .msg format. My
> code
> works on messages perfectly but not on those items mentioned. I did scrub
> the information and it still would not save. PLEASE HELP!!!!!

> Chris

 

[Chris]

Ken,

The Class I was referring to is the

Application.ActiveExplorer.CurrentFolder.Items.Item(I).Class. I had a return

of 43.

I do not know how to utilize MessageClass to isolate as it seems to call the

delivery receipt IPM.NOTE according to what was outputted to the messagebox

and not as what you had below. I am using Outlook 2007.

Chris
wrote:


> I'm not sure what you're talking about.

> Delivery reports for example have a MessageClass of "REPORT.IPM.Note.DR".
> That's not an email MessageClass.

> You would instantiate any item where the MessageClass starts with "REPORT"
> as a ReportItem, with which you should be able to use SaveAs().

> Most recipients won't allow delivery of either types of reports, but where
> you do get them back that's what you'd do.

> >

>

> "Chris" <Chris> wrote in message
> news:CB8A7BEA-8D3F-4E0B-972C-A746527770DC@microsoft.com...
> > Ken,
> > Is there a way to save the delivery and read receipts and meeting request
> > acceptances/declines?
> > I looked at the Class of the delivery receipt and it came up the same as a
> > message. There is no ol equivalent for a read or delivery receipt but
> > there
> > is for meeting requests.
> > I need to be able to copy everything in a folder to a .msg format. My
> > code
> > works on messages perfectly but not on those items mentioned. I did scrub
> > the information and it still would not save. PLEASE HELP!!!!!
> > Chris

> .
>

 

[Ken Slovak - [MVP - Outlook]]

You need to check the item's MessageClass property, which is a string. If

you are doing that in a procedure or event handler where the item is an

Object you would do that using reflection.

If you use Class, which won't work for you correctly, you will need to try a

cast to MailItem, if that fails try a cast to ReportItem and so on.

Personally I'd be using MessageClass myself.

I'd get MessageClass and use string.StartsWith() to see if the MessageClass

starts with "REPORT".

"Chris" <Chris> wrote in message

news:01F22F06-F7A2-4A64-849A-D68D6EF7F6A6@microsoft.com...
> Ken,

> The Class I was referring to is the
> Application.ActiveExplorer.CurrentFolder.Items.Item(I).Class. I had a
> return
> of 43.

> I do not know how to utilize MessageClass to isolate as it seems to call
> the
> delivery receipt IPM.NOTE according to what was outputted to the
> messagebox
> and not as what you had below. I am using Outlook 2007.

> Chris

 

[Chris]

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.Item(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--- wrote:


> You need to check the item's MessageClass property, which is a string. If
> you are doing that in a procedure or event handler where the item is an
> Object you would do that using reflection.

> If you use Class, which won't work for you correctly, you will need to try a
> cast to MailItem, if that fails try a cast to ReportItem and so on.
> Personally I'd be using MessageClass myself.

> I'd get MessageClass and use string.StartsWith() to see if the MessageClass
> starts with "REPORT".

> >

>

> "Chris" <Chris> wrote in message
> news:01F22F06-F7A2-4A64-849A-D68D6EF7F6A6@microsoft.com...
> > Ken,
> > The Class I was referring to is the
> > Application.ActiveExplorer.CurrentFolder.Items.Item(I).Class. I had a
> > return
> > of 43.
> > I do not know how to utilize MessageClass to isolate as it seems to call
> > the
> > delivery receipt IPM.NOTE according to what was outputted to the
> > messagebox
> > and not as what you had below. I am using Outlook 2007.
> > Chris

> .
>

 

[Ken Slovak - [MVP - Outlook]]

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.

"Chris" <Chris> wrote in message

news:7E7B26D3-E491-4C8D-AFB3-C6C437C09A15@microsoft.com...
> 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.Item(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-----

 

[Chris]

Ken:

Declaring it as an object worked. I am including the code below which also

includes a browser supported function in case anyone has the same problem

they can find it. Thank you for your help.

Chris

'-----CODE START---
Public Sub ExportSAR()

Dim TheEmail As Object

Dim ReportEmail As ReportItem

Dim eItem As Outlook.Items

Dim EmailNS As NameSpace

Dim fldrCount, EmailPath2, NbrItem, myfolder

Dim strSubj, strTime, mailClassCheck, EmailPath As String

Dim NewFileName, ReportHeader 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 = BrowseForFolderShell

MsgBox EmailPath

'EmailPath = InputBox("Enter the save folder location:", "Email Save

Path", CurDir)

For i = 1 To NbrItem

Set TheEmail = Application.ActiveExplorer.CurrentFolder.Items.Item(i)

mailClassCheck = TheEmail.MessageClass

If Left(mailClassCheck, 6) = "REPORT" Then

Set ReportEmail =

Application.ActiveExplorer.CurrentFolder.Items.Item(i)

If ReportEmail.Subject = "" Then strSubj = "no subject"

If Right(ReportEmail.MessageClass, 2) = "DR" Then ReportHeader =

"DeliveryReport" Else ReportHeader = "Read Receipt"

strSubj = Replace(ReportEmail.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(ReportEmail.CreationTime, "/", "-")

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)

NewFileName = ReportHeader & "_" & strSubj & strTime & ".msg"

If NewFileName <> "" Then

ReportEmail.SaveAs EmailPath & NewFileName, olMSG

Else

MsgBox "No file name was entered. Operation aborted.", 64,

"Cancel Operation"

Exit Sub

End If

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)

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:

strSubj = ""

strTime = ""

Next i

GoTo Done

Error_Handler:

If TheEmail Is Nothing Then

MsgBox Err.Number & ":" & Err.Description Else

MsgBox TheEmail.MessageClass & Chr$(13) & TheEmail.Subject & Chr$(13) &

Err.Number & ": " & Err.Description

TheEmail.Categories = TheEmail.Categories & ";" & "Not Copied"

TheEmail.Save

End If

Resume Next

Done:

End Sub

Public Function BrowseForFolderShell(Optional Hwnd As Long = 0, Optional

sTitle As String = "Browse for Folder", Optional BIF_Options As Integer,

Optional vRootFolder As Variant) As String

Dim objShell As Object

Dim objFolder As Variant

Dim strFolderFullPath As String

Set objShell = CreateObject("Shell.Application") Set objFolder =

objShell.BrowseForFolder(Hwnd, sTitle, BIF_Options, vRootFolder)

If (Not objFolder Is Nothing) Then

'// NB: If SpecFolder= 0 = Desktop then ....

On Error Resume Next

If IsError(objFolder.Items.Item.Path) Then strFolderFullPath =

CStr(objFolder): GoTo GotIt

On Error GoTo 0

'// Is it the Root Dir?...if so change

If Len(objFolder.Items.Item.Path) > 3 Then

strFolderFullPath = objFolder.Items.Item.Path '&

Application.PathSeparator

Else

strFolderFullPath = objFolder.Items.Item.Path '& Application.

End If

Else

'// User cancelled

GoTo XitProperly

End If

GotIt:

BrowseForFolderShell = strFolderFullPath & "\"

XitProperly:

Set objFolder = Nothing

Set objShell = Nothing

End Function

'-----CODE END--- wrote:


> 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.

> >

>

> "Chris" <Chris> wrote in message
> news:7E7B26D3-E491-4C8D-AFB3-C6C437C09A15@microsoft.com...
> > 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.Item(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-----

> .
>