Hello,

I need to Copy an opened mail item to a folder name EmailCopy and then move
this same item to another folder named SavedEmail. I've searched the
newsgroup and was able to obtain the code for the "move part" (see code). I
just can't figure out how to make a copy of the mail item first.

Sub ToFolder()
On Error Resume Next

Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem, objReport _
As Outlook.ReportItem

Set objNS = Application.GetNamespace("MAPI")

Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objInbox.Parent.Folders("SavedEmail")
'Assume this is a mail folder

If objFolder Is Nothing Then
MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, _
"INVALID FOLDER"
End If

If Application.ActiveExplorer.Selection.Count = 0 Then
'Require that this procedure be called only when a message is selected
Exit Sub
End If

For Each objItem In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move objFolder
End If
End If
Next

For Each objReport In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objReport.Move objFolder
End If
End If
Next

Set objItem = Nothing
Set objReport = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub

Any assistance would be greatly appreciated!
Thanks!

You must have missed the MailItem.Copy method:

Set objCopy = objItem.Copy
objCopy.Move objFolder

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003
http://www.turtleflock.com/olconfig/index.htm
and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
http://www.outlookcode.com/jumpstart.aspx

"LDMueller" wrote in message ...
Hello,

I need to Copy an opened mail item to a folder name EmailCopy and then move
this same item to another folder named SavedEmail. I've searched the
newsgroup and was able to obtain the code for the "move part" (see code). I
just can't figure out how to make a copy of the mail item first.

Sub ToFolder()
On Error Resume Next

Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem, objReport _
As Outlook.ReportItem

Set objNS = Application.GetNamespace("MAPI")

Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objInbox.Parent.Folders("SavedEmail")
'Assume this is a mail folder

If objFolder Is Nothing Then
MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, _
"INVALID FOLDER"
End If

If Application.ActiveExplorer.Selection.Count = 0 Then
'Require that this procedure be called only when a message is selected
Exit Sub
End If

For Each objItem In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move objFolder
End If
End If
Next

For Each objReport In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objReport.Move objFolder
End If
End If
Next

Set objItem = Nothing
Set objReport = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub

Any assistance would be greatly appreciated!
Thanks!