Macro VBA Outlook 2007 - Mover Pasta

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 é:

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
 
Back
Topo