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


"Ken Slovak - [MVP - Outlook]" wrote: