The following code is what you gave me that when I select a contact, it moves to the specific folder or sub folder or sub sub folder....this is an example for a folder to a bank name....so what can I add at the end that it still moves the contact to the folder put in the code, but it also opens up that folder? Since I have many many folders, this would be helpful.
Sub MoveSelectedContactsToContacts_Marketing_Marketing_Banks_Community_Bank_of_Texas()
Dim objFolder As outlook.MAPIFolder, objInbox As outlook.MAPIFolder
Dim objNS As outlook.NameSpace, objItem As outlook.contactItem
Set objNS = Application.GetNamespace("MAPI")
Set objContacts = objNS.GetDefaultFolder(olFolderContacts)
On Error Resume Next
Set objFolder = objContacts.Folders("Marketing -").Folders("Marketing - Banks").Folders("Marketing - Banks - Community Bank of Texas")
'Assume this is a contact 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 contact is selected
Exit Sub
End If
For Each objItem In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olContactItem Then
If objItem.Class = olContact Then
objItem.Move objFolder
End If
End If
Next
Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub
Sub MoveSelectedContactsToContacts_Marketing_Marketing_Banks_Community_Bank_of_Texas()
Dim objFolder As outlook.MAPIFolder, objInbox As outlook.MAPIFolder
Dim objNS As outlook.NameSpace, objItem As outlook.contactItem
Set objNS = Application.GetNamespace("MAPI")
Set objContacts = objNS.GetDefaultFolder(olFolderContacts)
On Error Resume Next
Set objFolder = objContacts.Folders("Marketing -").Folders("Marketing - Banks").Folders("Marketing - Banks - Community Bank of Texas")
'Assume this is a contact 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 contact is selected
Exit Sub
End If
For Each objItem In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olContactItem Then
If objItem.Class = olContact Then
objItem.Move objFolder
End If
End If
Next
Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub