Am Wed, 20 Sep 2006 07:39:03 -0700 schrieb LDMueller:

Please compare the code yourself line for line: The only things wich are
different are the target folders.

So actually we need to discuss one sample only. But there´re a few bugs in
it:

1) If objFolder is Nothing you should leave the procedure after displaying
the MsgBox - like you do it if Selection.Count is 0.

2) In your sample you copy only the first selected item but then try to move
all selected items.

3) Because the mail folder could contain different objects you must not use
objItem (MailItem) or objReport (ReportItem) to loop through it, but a
generic object. sample:

Dim obj as Object
Dim i as Long
Dim Sel as Selection
Set Sel=Application.ActiveExplorer.Selection
For i=Sel.Count To 1 Step -1
Set obj=Sel(i)
Select Case True
Case (TypeOf obj is Outlook.MailItem), (TypeOf obj is Outlook.ReportItem)
Set objCopy=obj.Copy
obj.Move Folder1
objCopy.Move Folder2
End Select
Next

4) The sample shows another issue: If you move items out off a list the loop
must count backwards.

By using a generic object you don´t need to differ between MailItems and
ReportItems.

5) The check, whether or not objFolder1.DefaultItemType is olMailItem, could
be done right after realizing that objFolder1 is not nothing. Because the
object doesn´t change it isn´t necessary to check that for each selected
item again and again.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.VBOffice.net --


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