Outlook: Como remover itens duplicados da agenda

Por vezes, surgem itens duplicados na agenda ao importar eventos de outros dispositivos. Para os eliminar, este tutorial apresenta dois métodos distintos: um permite removê-los manualmente, um a um, quando são poucos; o outro recorre a VBA para eliminar todas as duplicações de uma só vez.

Eliminar manualmente Remover duplicatas os itens da agenda um a um

Utilizar VBA para Remover duplicatas os itens da agenda de uma só vez

---

Eliminar manualmente Remover duplicatas os itens da agenda um a um

Para remover itens duplicados da agenda um a um, comece por organizá-los numa ordem que torne as duplicações claramente visíveis e, depois, elimine-os individualmente.

1. Geralmente, a agenda está na vista «Agenda». Ative a agenda em que pretende remover duplicatas e, em seguida, clique em «Ver» > «Alterar Vista» > «Lista».

Agora, a agenda é exibida em formato de lista.

2. Em seguida, defina uma condição para identificar itens duplicados — por exemplo, verificar se partilham o mesmo assunto. Clique em «ASSUNTO» na lista da agenda; assim, todos os itens com assunto igual ficam agrupados.

3. Agora pode eliminar os itens com o mesmo assunto um a um: clique com o botão direito do rato no item e selecione «Eliminar» no menu de contexto que surge.

---

---

Utilizar VBA para Remover duplicatas os itens da agenda de uma só vez

Apresentamos aqui um código VBA capaz de remover todos os itens duplicados numa pasta da agenda, adaptado a diversos cenários.

1. Prima «Alt» + «F11» para abrir a janela «Microsoft Visual Basic for Applications».

2. Clique em «Inserir» > «Módulo» para criar um novo módulo em branco e, de seguida, copie e cole o código abaixo para esse módulo.

VBA: remover todos os itens duplicados da agenda numa categoria específica

'Sub RemoveDuplicateCalendar()
'UpdatebyExtendoffice20220413
  Dim xStores As Stores
  Dim xStore As Store
  Dim xRootFolder As Folder
  Dim xFolder As Object
  Set xStores = Application.Session.Stores
  For Each xStore In xStores
    Set xRootFolder = xStore.GetRootFolder
    For Each xFolder In xRootFolder.Folders
      Call ProcessFolders(xFolder)
    Next
  Next
  Set xStores = Nothing
End Sub

Sub ProcessFolders(ByVal CurrentFld As Folder)
  Dim xDictionary As Object
  Dim i As Long
  Dim xItem As Object
  Dim xKey As String
  Dim xSubFld As Folder
  On Error Resume Next
  If CurrentFld.DefaultItemType <> olAppointmentItem Then Exit Sub
  Set xDictionary = CreateObject("Scripting.Dictionary")
  For i = CurrentFld.Items.Count To 1 Step -1
    Set xItem = CurrentFld.Items.Item(i)
    'change categories as you need in below script
    If xItem.Categories = "date" Then
    'change the comparing items as you need
      xKey = xItem.Subject & xItem.Location & xItem.Body & xItem.Categories
      If xDictionary.Exists(xKey) = True Then
        xItem.Delete
      Else
        xDictionary.Add xKey, True
      End If
    End If
  Next i
  For Each xSubFld In CurrentFld.Folders
    ProcessFolders xSubFld
  Next
End Sub

Neste código VBA, todas as duplicações na categoria «date» são removidas com base na comparação de assunto, localização, corpo e categoria. Pode ajustar estes critérios conforme necessário.

3. Depois, prima «F5» ou clique em Executar para executar o código. Surge uma caixa de diálogo «Macros»; selecione «RemoveDuplicateCalendar» e clique em «Executar».

Os itens duplicados na categoria «date» foram agora removidos.

VBA: remover todos os itens duplicados da agenda em todas as categorias

Sub RemoveDuplicateCalendar()
'UpdatebyExtendoffice20220413
  Dim xStores As Stores
  Dim xStore As Store
  Dim xRootFolder As Folder
  Dim xFolder As Object
  Set xStores = Application.Session.Stores
  For Each xStore In xStores
    Set xRootFolder = xStore.GetRootFolder
    For Each xFolder In xRootFolder.Folders
      Call ProcessFolders(xFolder)
    Next
  Next
  Set xStores = Nothing
End Sub

Sub ProcessFolders(ByVal CurrentFld As Folder)
  Dim xDictionary As Object
  Dim i As Long
  Dim xItem As Object
  Dim xKey As String
  Dim xSubFld As Folder
  On Error Resume Next
  If CurrentFld.DefaultItemType <> olAppointmentItem Then Exit Sub
  Set xDictionary = CreateObject("Scripting.Dictionary")
  For i = CurrentFld.Items.Count To 1 Step -1
    Set xItem = CurrentFld.Items.Item(i)
    'change the comparing items as you need
      xKey = xItem.Subject & xItem.Location & xItem.Body & xItem.Categories
      If xDictionary.Exists(xKey) = True Then
        xItem.Delete
      Else
        xDictionary.Add xKey, True
      End If
  Next i
  For Each xSubFld In CurrentFld.Folders
    ProcessFolders xSubFld
  Next
End Sub

Ao executar este código, são removidas todas as duplicações que partilhem o mesmo assunto, localização, corpo e categoria dentro de cada categoria.

NotaO código VBA acima funciona na pasta da agenda, incluindo todas as suas subpastas.