Move E-Mails to Another Folder

[LMS]

Please explain what to do as I simply set it up as If ObjItem.Class = olreportitem then but it did not work

 

[LMS]

So just use the line:

If ObjItem.Class = olMail Or ObjItem = olReport Then
ObjItem.Move objFolder

 

[LMS]

Can you please write in exactly what I am supposed to change re the following:

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

 

[LMS]

I did the Message Class and it shows up as REPORT.IPM.NOTE.NDR So is there something to change to make it work

 

[LMS]

I did the Message Class and it shows up as REPORT.IPM.NOTE.NDR So is there something to change to make it work

 

[Diane Poremsky]

So just use the line:
If ObjItem.Class = olMail Or ObjItem = olReport Then
ObjItem.Move objFolder

This should work. Oh wait, another typo... you need objitem.class:

If ObjItem.Class = olMail Or ObjItem.class = olReport Then

 

[LMS]

I tried what you wrote and it does not move the email.

 

[Diane Poremsky]

I'm out of ideas, sorry. It *should* work.

 

[LMS]

I appreciate it....so here is the full code with what you said....so please take one more look at it and see if there is anything ot change or add please:

Sub MoveSelectedMessagesToFolderUndeliveredEmails()
Dim objFolder As outlook.MAPIFolder, objInbox As outlook.MAPIFolder
Dim objNS As outlook.NameSpace, ObjItem As outlook.mailItem
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
On Error Resume Next
Set objFolder = objInbox.Folders("Undelivered E-Mails")
'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 Or ObjItem.Class = olReport Then
ObjItem.Move objFolder
End If
End If
Next
Set ObjItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub

 

[larry]

I'm no programmer and I don't play one on TV, but do you need to identify if it's a message? Your code sample runs on selected messages, so you only select the ones that you want moved. Then you could remove the If objFolder.DefaultItemType = olMailItem Then line and the end if after ObjItem.Move objFolder.

It seems like you are putting a lot of effort into a technological solution for a simple issue. The ROI can't be that great? I'd add the Undelivered E-Mails folder to the Favorite folder list so it's easy to find and drag the bounced mail to it.

 

[LMS]

I appreciate it....so here is the full code with what you said....so please take one more look at it and see if there is anything ot change or add please:

Sub MoveSelectedMessagesToFolderUndeliveredEmails()
Dim objFolder As outlook.MAPIFolder, objInbox As outlook.MAPIFolder
Dim objNS As outlook.NameSpace, ObjItem As outlook.mailItem
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
On Error Resume Next
Set objFolder = objInbox.Folders("Undelivered E-Mails")
'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 Or ObjItem.Class = olReport Then
ObjItem.Move objFolder
End If
End If
Next
Set ObjItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub

 

[Forum Admin]

Try dimming objitem as variant or object instead of mailitem. or just dim it:

dim objItem

@mrsadmin used olreports but in the code she used, it was dimmed as a variant.

 

[LMS]

I tried the different ways re Dim and nothing worked. Any other ideas?

 

[LMS]

Thru a Microsoft Forum, I found the following which moves the report, but not all selected, just one report each time...so what can we change to this so when I select more than one report email, it moves all of them

Sub MoveSelectedMessagesToFolderUndeliveredEmails4()
Dim objFolder As outlook.MAPIFolder, objInbox As outlook.MAPIFolder
Dim objNS As outlook.NameSpace, objItem As outlook.mailItem
Dim olReport
Dim olMail
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
On Error Resume Next
Set objFolder = objInbox.Folders("Undelivered E-Mails")
'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
Set Item = Application.ActiveExplorer.Selection(1)
Set Folder = objInbox.Folders("Undelivered E-Mails")
Item.Move Folder
Next
Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub

 

[Diane Poremsky]

That looks like what larry suggested.

you need to use the for each in the selection from the original code, or just remove the if statements from it.

For Each ObjItem In Application.ActiveExplorer.Selection
ObjItem.Move objFolder
Next

 

[LMS]

That looks like what larry suggested.

you need to use the for each in the selection from the original code, or just remove the if statements from it.

For Each ObjItem In Application.ActiveExplorer.Selection
ObjItem.Move objFolder
Next

I don't understand what to actually change...can you give me the exact thing to add and where and what to delete?

 

[Diane Poremsky]

this is your original code with the lines checking the item type removed - the code you posted from the ms forum is messy - messier than even some of my code.

if this worked for a selection of email it will work for a selection of anything with the lines checking the class removed.

Sub MoveSelectedMessagesToFolderUndeliveredEmails() 
Dim objFolder As outlook.MAPIFolder, objInbox As outlook.MAPIFolder 
Dim objNS As outlook.NameSpace, ObjItem As outlook.mailItem 
Set objNS = Application.GetNamespace("MAPI") 
Set objInbox = objNS.GetDefaultFolder(olFolderInbox) 
On Error Resume Next 
 
Set objFolder = objInbox.Folders("Undelivered E-Mails") 
'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 
    ObjItem.Move objFolder 
Next 
 
Set ObjItem = Nothing 
Set objFolder = Nothing 
Set objInbox = Nothing 
Set objNS = Nothing 
End Sub

 

[LMS]

I copied and pasted and tested what you just posted and it did nothing....sorry!!

 

[Diane Poremsky]

the last code i posted works perfectly here. Step into the code and see what it does.

 

[LMS]

I don't know what you said to review the code