Inicio MS / Office

VBScript – Guardar Correos Seleccionados en un mismo Archivo Doc (Word)



Ultima Actualización del Artículo: Sep 27, 2016

El siguiente código VBscript sirve para guardar correos seleccionados en un mismo archivo doc, al momento de leer el cuerpo del correo este pierde el formato el cual quedara en formato plain text y al momento de guardar ya que el archivo Doc contendrá la información de los correos seleccionados toma el valor de la fecha actual y se el asigna al nombre del archivo.

Instrucciones de Uso

1.- Abrir el editor de Visual Basic (ALT+F11).

2.- Insertar un modulo nuevo (Insert > Module).

3.- Copiar el código VBScript.

4.- En la linea 8 debemos especificar la ruta donde se guardaran los archivos (Esta carpeta la creamos manualmente).

5.- En la linea 13 automáticamente asigna la fecha al nombre del archivo en el formato Año-Mes-Dia-Hora el cual podemos remplazar “Format(Now(), “yyyy-mm-dd-hh” por cualquier nombre.

6.- Ahora desde el editor de Visual Basic una vez seleccionados los correos a exportar a Doc ejecutamos el script.

Para mas información de configuración ver: Como utilizar el Editor VBA en Office (Utilizar Macros VBScript) y Outlook – Crear y configurar reglas

Código

Sub MergeSelectedEmailsIntoDocFile()
 
Dim objItem As Object, strFile As String
Dim sName As String
Set objFS = CreateObject("Scripting.FileSystemObject")
 
Dim saveFolder As String
saveFolder = "C:\1-Tests\"
 
  If ActiveExplorer.Selection.count = 0 Then Exit Sub

' add the current date to the filename Year-Month-Day-Hour
sName = Format(Now(), "yyyy-mm-dd-hh")
 
' The folder path you use needs to exist
strFile = saveFolder & sName & ".doc"
   
  Set objFile = objFS.CreateTextFile(strFile, False)
  If objFile Is Nothing Then
    MsgBox "Error creating file '" & strFile & "'.", vbOKOnly + vbExclamation _
      , "Invalid File"
    Exit Sub
  End If
   
  For Each objItem In ActiveExplorer.Selection
   
  With objFile
    .Write vbCrLf & "--Email Start--" & vbCrLf
    .Write "Sender: " & objItem.Sender & " <" & objItem.SenderEmailAddress & ">" & vbCrLf
    .Write "Recipients : " & objItem.To & vbCrLf
    .Write "Received: " & objItem.ReceivedTime & vbCrLf
    .Write "Subject: " & objItem.Subject & vbCrLf & vbCrLf
    .Write objItem.Body
    .Write vbCrLf & "--Email End--" & vbCrLf
 End With
 
  Next
  objFile.Close
   
  MsgBox "Email text merge completed!", vbOKOnly + vbInformation, "DONE!"
   
  Set objFS = Nothing
  Set objFile = Nothing
  Set objItem = Nothing
   
End Sub

Basado un codigo de Diane Poremsky publicado en slipstick

Artículos que te pueden interesar:
 
VíaDiane Poremsky
Fuenteslipstick
COMPARTIR
Mi nombre es Fernando, soy analista de sistemas actualmente trabajo en una empresa con mas de 200 empleados que utilizan equipo de computo al cual se les da soporte en el departamento. Uno de mis pasatiempos fuera de la empresa es escribir artículos para PortalMasTips donde documento los problemas, inquietudes y detalles interesantes que se presentan.

1 Comentario

  1. Hola!
    Muchas gracias por el artículo. efectivamente me junta lo correos seleccionados que guardo en una carpeta de outlook, lo que me significa un gran avance.
    En la línea 1 del código usé Sub MergeSelectedEmailsIntoDocFile(itm As Outlook.MailItem) para poder usarlo como script desde outlook.
    Ahora lo que comentaste sobre que mantenga el formato con que fue recibido sería perfecto! porque necesito rescatar tablas que vienen en el cuerpo del correo.
    Estuve buscando y hay un formato .mht que si se abre con word rescata formato, imágenes, etc. Creo que por ahí se puede lograr algo.
    Muchas gracias nuevamente.

    Saludos

Deja un comentario...