¡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:
- Abre Outlook.
- Presiona
Alt + F11para abrir el Editor de VBA. - Inserta un nuevo módulo (
Insert > Module). - Copia y pega el script en el módulo.
- Cierra el Editor de VBA.
- Ejecuta el script desde Outlook (
Alt + F8, seleccionaEliminarCorreosDuplicadosy haz clic enRun).
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.