K
Keith Brown
I am using a bunch of macros that someone programmed for me to move emails
from the Inbox to specific folders. Now I want to "expand" what the macro
and the person who did the programming no longer works for us.
The basic macro is as follows, and I don't know what to add to the macro to
assign specific categories to the email. I know I will probably have to
duplicate the macro several times for each of the different categories I
might assign to it, but I am lost.
Sub MoveToFolderA()
On Error Resume Next
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)
Set objFolder = objInbox.Folders("FolderA") '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
Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub
Thanks,
Keith
from the Inbox to specific folders. Now I want to "expand" what the macro
and the person who did the programming no longer works for us.
The basic macro is as follows, and I don't know what to add to the macro to
assign specific categories to the email. I know I will probably have to
duplicate the macro several times for each of the different categories I
might assign to it, but I am lost.
Sub MoveToFolderA()
On Error Resume Next
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)
Set objFolder = objInbox.Folders("FolderA") '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
Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub
Thanks,
Keith