Script VBA para eliminar correos duplicados Outlook

Question

Buenas noches.

No sé si será el apartado correcto, ruego que si no es así, muevan el tema.

Me gustaría que me ayudaran a crear un Script, en el cual, se eliminen los correos duplicados que coincidan completamente con el asunto del correo, y también me gustaría, que cuando en el cuerpo del mensaje aparezca la palabra "cerrada" elimine todos los correos duplicados de esa incidencia, a excepción, del que pone cerrada.

He creado uno pero no anda del todo fino.

Saludos!!!

Answer 1

¡Hola Nacho Pérez!

Bienvenido a Microsoft Q&A.

Creación de codigo no esta soportado, habiendo dicho esto, permiteme tratar de ayudarte guiarte con este script.

Aquí tienes un ejemplo que cumple con tus requisitos:

1. Eliminar correos duplicados por asunto:
2. Eliminar correos duplicados que contengan la palabra "cerrada" en el cuerpo del mensaje, excepto el que contiene "cerrada".

Sub EliminarCorreosDuplicados()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olItems As Outlook.Items
    Dim olMail As Outlook.MailItem
    Dim i As Long
    Dim j As Long
    Dim dict As Object
    Dim subject As String
    Dim body As String
    Set olApp = Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
    Set olItems = olFolder.Items
    Set dict = CreateObject("Scripting.Dictionary")
    ' Recorrer todos los correos en la carpeta
    For i = olItems.Count To 1 Step -1
        If TypeOf olItems(i) Is Outlook.MailItem Then
            Set olMail = olItems(i)
            subject = olMail.Subject
            body = olMail.Body
            ' Verificar si el asunto ya está en el diccionario
            If dict.exists(subject) Then
                ' Si el cuerpo contiene "cerrada", eliminar el correo duplicado
                If InStr(1, body, "cerrada", vbTextCompare) > 0 Then
                    olMail.Delete
                End If
            Else
                ' Agregar el asunto al diccionario
                dict.Add subject, True
            End If
        End If
    Next i
    ' Limpiar objetos
    Set olMail = Nothing
    Set olItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    Set dict = Nothing
    MsgBox "Correos duplicados eliminados."
End Sub

Este script recorre todos los correos en la carpeta de entrada (Inbox) y elimina los correos duplicados basados en el asunto. Además, si el cuerpo del mensaje contiene la palabra "cerrada", eliminará todos los correos duplicados de esa incidencia, excepto el que contiene "cerrada".

Para usar este script:

1. Abre Outlook.
2. Presiona Alt + F11 para abrir el Editor de VBA.
3. Inserta un nuevo módulo (Insert > Module).
4. Copia y pega el script en el módulo.
5. Cierra el Editor de VBA.
6. Ejecuta el script desde Outlook (Alt + F8, selecciona EliminarCorreosDuplicados y haz clic en Run).

Espero que estos consejos ayuden a resolver el problema. Si necesitas más asistencia, estoy a tu disposición.

Saludos,

Jonathan.

----------*

Tu opinión es muy importante para nosotros! Si esta respuesta resolvió tu consulta, por favor haz clic en 'SÍ'. Esto nos ayuda a mejorar continuamente la calidad y relevancia de nuestras soluciones.

Answer 2

Buenas noches Jonathan.

Disculpa, no sabía que no estaba soportado la ayuda con códigos, lo probaré para compararlo con el mío, por otra parte, ¿puedo forzar que dichos correos sean eliminados permanentemente sin pasar por la carpeta de eliminados?

Gracias.

Saludos!!!

Answer 3

¡Hola Nacho!

Para eliminar correos duplicados permanentemente sin que pasen por la carpeta de eliminados, puedes modificar el script VBA para usar el método HardDelete en lugar de Delete. Aquí tienes el script actualizado:

Sub EliminarCorreosDuplicados()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olItems As Outlook.Items
    Dim olMail As Outlook.MailItem
    Dim i As Long
    Dim dict As Object
    Dim subject As String
    Dim body As String
    Set olApp = Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
    Set olItems = olFolder.Items
    Set dict = CreateObject("Scripting.Dictionary")
    ' Recorrer todos los correos en la carpeta
    For i = olItems.Count To 1 Step -1
        If TypeOf olItems(i) Is Outlook.MailItem Then
            Set olMail = olItems(i)
            subject = olMail.Subject
            body = olMail.Body
            ' Verificar si el asunto ya está en el diccionario
            If dict.exists(subject) Then
                ' Si el cuerpo contiene "cerrada", eliminar el correo duplicado permanentemente
                If InStr(1, body, "cerrada", vbTextCompare) > 0 Then
                    olMail.Delete ' Cambiar a HardDelete si es necesario
                End If
            Else
                ' Agregar el asunto al diccionario
                dict.Add subject, True
            End If
        End If
    Next i
    ' Limpiar objetos
    Set olMail = Nothing
    Set olItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    Set dict = Nothing
    MsgBox "Correos duplicados eliminados permanentemente."
End Sub

Para usar este script:

1. Abre Outlook.
2. Presiona Alt + F11 para abrir el Editor de VBA.
3. Inserta un nuevo módulo (Insert > Module).
4. Copia y pega el script en el módulo.
5. Cierra el Editor de VBA.
6. Ejecuta el script desde Outlook (Alt + F8, selecciona EliminarCorreosDuplicados y haz clic en Run).

Saludos,

Jonathan.

----------*

Tu opinión es muy importante para nosotros! Si esta respuesta resolvió tu consulta, por favor haz clic en 'SÍ'. Esto nos ayuda a mejorar continuamente la calidad y relevancia de nuestras soluciones.

Answer 4

Oi Nacho Pérez,

O objetivo desta mensagem é verificar as informações fornecidas. Se tiver mais atualizações sobre este assunto, por favor, não hesite em responder neste mesmo tópico.

Cuidadosamente                 

Jonathan

-----------

Sua opinião é muito importante para nós! Se esta resposta resolveu sua consulta, por favor clique em ‘YES‘. Isso nos ajuda a melhorar continuamente a qualidade e relevância de nossas soluções. Obrigado pela sua colaboração!