¿Cómo guardar varios correos electrónicos seleccionados como archivos MSG de forma masiva en Outlook?

Guardar un correo electrónico como archivo MSG en Outlook es sencillo. Pero, ¿cómo puede guardar varios correos electrónicos seleccionados como archivos MSG individuales de forma masiva en Outlook? Este artículo le mostrará un método para lograrlo.

Guardar varios correos electrónicos seleccionados como archivos MSG con código VBA

---

Guardar varios correos electrónicos seleccionados como archivos MSG con código VBA

El siguiente código VBA le permite guardar varios correos electrónicos seleccionados en Outlook como archivos MSG individuales de forma masiva. Siga estos pasos.

1. Seleccione los correos electrónicos que desea guardar como archivos MSG y, a continuación, pulse simultáneamente las teclas «Alt» + «F11» para abrir la ventana de Microsoft Visual Basic para Aplicaciones.

2. En la ventana de Microsoft Visual Basic para Aplicaciones, haga clic en «Insertar» > «Módulo» y, a continuación, copie el siguiente código VBA en la ventana del módulo.

Código VBA: Guardar varios correos electrónicos seleccionados como archivos MSG individuales en Outlook

Public Sub SaveMessageAsMsg()
'Update by Extendoffice 2018/3/5
Dim xMail As Outlook.MailItem
Dim xObjItem As Object
Dim xPath As String
Dim xDtDate As Date
Dim xName, xFileName As String
On Error Resume Next
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.BrowseForFolder(0, "Select a folder:", 0, strStartingFolder)
If Not TypeName(xFolder) = "Nothing" Then
    Set xFolderItem = xFolder.self
    xFileName = xFolderItem.Path & "\"
Else
    xFileName = ""
    Exit Sub
End If
For Each xObjItem In Outlook.ActiveExplorer.Selection
    If xObjItem.Class = olMail Then
        Set xMail = xObjItem
        xName = xMail.Subject
        xDtDate = xMail.ReceivedTime
        xName = Format(xDtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
          vbUseSystem) & Format(xDtDate, "-hhnnss", _
          vbUseSystemDayOfWeek, vbUseSystem) & "-" & xName & ".msg"
        xPath = xFileName + xName
        xMail.SaveAs xPath, olMSG
    End If
Next
End Sub

3. Pulse la tecla «F5» para ejecutar el código.

4. En el cuadro de diálogo «Examinar carpetas», seleccione la carpeta en la que desea guardar los archivos MSG y, a continuación, haga clic en «Aceptar». Vea la captura de pantalla:

Ahora todos los correos electrónicos seleccionados se han guardado como archivos MSG individuales, tal como se muestra en la siguiente captura de pantalla.

---