pintodiogo
Power Member
Boa Tarde ao pessoal
Se alguém me puder ajudar agradecia.
Há algum tempo que uso uma macro no Outlook que me move o email que estiver seleccionado para uma pasta pré-definida.
Acontece que agora gostaria de mover uma pasta inteira e não apenas mail a mail. Será isto possível?
Ex: Na pasta "A receber" tenho várias subpastas com os anos (2014;2013;...), cada uma deles tem subpastas com o nome do cliente, sendo que cada email é guardado na pasta correspondente seguindo esses critérios. O que queria era uma macro para mover por exemplo uma pasta de um cliente para uma pasta já existente chamada "Resolvidos".
O código para mover os email é individualmente é:
Se alguém me puder ajudar agradecia.
Há algum tempo que uso uma macro no Outlook que me move o email que estiver seleccionado para uma pasta pré-definida.
Acontece que agora gostaria de mover uma pasta inteira e não apenas mail a mail. Será isto possível?
Ex: Na pasta "A receber" tenho várias subpastas com os anos (2014;2013;...), cada uma deles tem subpastas com o nome do cliente, sendo que cada email é guardado na pasta correspondente seguindo esses critérios. O que queria era uma macro para mover por exemplo uma pasta de um cliente para uma pasta já existente chamada "Resolvidos".
O código para mover os email é individualmente é:
Código:
Sub MoverEmail()
On Error Resume Next
Dim ns As Outlook.NameSpace
Dim moveToFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
Set ns = Application.GetNamespace("MAPI")
'Define path to the target folder
Set moveToFolder = ns.Folders("[email protected]").Folders("2013")
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("Nenhum Item Seleccionado")
Exit Sub
End If
If moveToFolder Is Nothing Then
MsgBox "Pasta de destino não encontrada!", vbOKOnly + vbExclamation, "Erro"
End If
For Each objItem In Application.ActiveExplorer.Selection
If moveToFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.move moveToFolder
End If
End If
Next
Set objItem = Nothing
Set moveToFolder = Nothing
Set ns = Nothing
End Sub