I need to be able to select a mail item in my inbox, make a copy of it and
move the original to a folder named "Saved Mail" and move the copy to a
folder named "Copied Mail". The only way I've been sucessful doing this is
to create two separate macros (see my provided code) which I created after
searching the newgroup for help.

I was hoping someone can help me combine the code into one macro.

Thanks.

Sub copy()
On Error Resume Next

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

Set objNS = Application.GetNamespace("MAPI")

Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objInbox.Parent.Folders("Saved Mail")
'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

'Make copy of mail item
Set objOrig = Application.ActiveExplorer.Selection.Item(1)
Set objCopy = objOrig.copy
' objCopy.copy

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

Sub copy1()
On Error Resume Next

Dim objFolder1 As Outlook.MAPIFolder
Dim objInbox1 As Outlook.MAPIFolder
Dim objNS1 As Outlook.NameSpace
Dim objItem1 As Outlook.MailItem
Dim objReport1 As Outlook.ReportItem

Set objNS1 = Application.GetNamespace("MAPI")

Set objInbox1 = objNS1.GetDefaultFolder(olFolderInbox)
Set objFolder1 = objInbox1.Parent.Folders("Copied Mail")
'Assume this is a mail folder

If objFolder1 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 objItem1 In Application.ActiveExplorer.Selection
If objFolder1.DefaultItemType = olMailItem Then
If objItem1.Class = olMail Then
objItem1.move objFolder1
End If
End If
Next

For Each objReport1 In Application.ActiveExplorer.Selection
If objFolder1.DefaultItemType = olMailItem Then
If objItem1.Class = olMail Then
objReport1.move objFolder1
End If
End If
Next

Set objItem1 = Nothing
Set objReport1 = Nothing
Set objFolder1 = Nothing
Set objInbox1 = Nothing
Set objNS1 = Nothing

End Sub