VBScript – Imprimir adjunto automáticamente al momento de recibir un correo en Outlook

Publicidad +
Publicidad +
Publicidad +
Publicidad +

El siguiente VBScript imprime adjuntos automáticamente al momento de recibir un correo en Outlook, se puede especificar las extensiones del tipo de archivo que se desea imprimir, de quien o que tipo de correos se van a imprimir los adjuntos.

Indice de Contenido

Instrucciones

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

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

3.- Copiar el codigo VBScript.

4.- Para hacer uso de este debemos crear 2 directorios (Carpetas) el cual especificaremos la ruta en las lineas 12, 25 y 30 del código; debemos prestar cuidado cuando la ruta se escribe con \ al final o no.

5.- En la linea 14 debemos especificar la extensión de los archivos en el actual se especificaron DOC, DOCX, PDF y TXT; Si realizas cambios es importante poner en mayúsculas las extensiones, tambien se pueden agregar o quitar, para eliminar debes eliminar Or InStr(UCase(objAtt.DisplayName), “.DOCX”)  

6.- Si deseamos que se eliminen (O se tiene problema con archivos repetidos) los archivos que se imprimen debemos quitar el apostrofe de la linea 30.

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

Proceso

El código realiza el siguiente proceso.

  1. Al recibir correo revisa si contiene adjuntos.
  2. Si contiene adjuntos revisa las extensiones de estos.
  3. Si alguno de los especificados se encuentra se extrae ruta y nombre del archivo.
  4. Lo guarda en el folder temporal C:\Imprimir (Este se puede modificar).
  5. Envia a imprimir el documento
  6. Mueve el archivo a la carpeta C:\Imprimir\Impresos\
  7. Hasta finalizar con los archivos adjuntos.

Código

Public Sub ToPrintAttachments(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim FullFileName As String
Dim objFSO As Object
Dim WScript As Object
Dim dteWait
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set WScript = CreateObject("WScript.Shell")
Set objShell = CreateObject("Shell.Application")
 
saveFolder = "C:\Imprimir"
For Each objAtt In itm.Attachments
    If ((InStr(UCase(objAtt.DisplayName), ".DOC") Or InStr(UCase(objAtt.DisplayName), ".DOCX") Or InStr(UCase(objAtt.DisplayName), ".TXT") Or InStr(UCase(objAtt.DisplayName), ".PDF"))) Then
              FullFileName = saveFolder & "\" & objAtt.DisplayName
              objAtt.SaveAsFile (FullFileName)
              'printAttachments saveFolder
              Set objFolder = objShell.NameSpace(0)
              Set printItem = objFolder.ParseName(FullFileName)
              printItem.InvokeVerbEx ("Print")
                ' delay before move and delete
              dteWait = DateAdd("s", 5, Now())
              Do Until (Now() > dteWait)
              Loop
                objFSO.MoveFile "C:\Imprimir\*", "C:\Impresos\"
                ' delay before move and delete
              dteWait = DateAdd("s", 5, Now())
              Do Until (Now() > dteWait)
              Loop
                'Desmarcar la linea siguiente para eliminar los archivos temporales (quitar apostrofe)
                objFSO.DeleteFile ("C:\Impresos\*")
                ' delay before finish
              dteWait = DateAdd("s", 5, Now())
              Do Until (Now() > dteWait)
              Loop
    End If
Next
End Sub

Califica este articulo

Fernando O.

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.

44 comentarios en “VBScript – Imprimir adjunto automáticamente al momento de recibir un correo en Outlook

  1. Hola, intentare con este script. Actualmente lo tengo configurado con una regla que comprueba cuando un correo entrante tiene un dato adjunto, marque como leido, categorize como impreso e imprima. Tengo la opcion habilitada de “imprimir datos adjuntos. Cuando llega el correo lo marca como leido y lo categoriza correctamente, pero solo imprime la caratula del correo y el adjunto no. Me sale un error en ACROBAT de que no se encuentra el archivo especificado.
    Sabes por que?
    Espero me puedas ayudar,saludos.

    • Buen dia

      Si tienes Windows 7 en adelante te puede estar causando el error el User Account Control; desactivarlo y reinicia el equipo cuando lo pida, este causa problemas de acceso cuando son carpetas mappeadas y temporales.

      • Asi es, W7 X64 Outlook 2013 X64 y ACROBAT PRO. Hoy pruebo esa solucion y te comento en que resulto, aunque me suena muy logico porque trabajo en un entono muy controlado y de hecho no tengo permisos de administrador.

        Te aviso, gracias

  2. Hola:
    Me parece interensante el codigo VBScript , pero me gustaria que saber como hacer para que imprima automaticamente 2 copias del archivo adjunto.

  3. Hola, estoy probando este script en un windows 10, con outlook pro 2010 y no me responde, no se donde está el error. He realizado pruebas sobre la misma regla y esta si se ejecuta, pero el script ni copia el adjunto ni lo imprime. He modificado el UAC como proponen más arriba.

    Saludos y gracias!

      • Buenas Tardes

        Las extensiones que necesito imprimir son *.pdf. *.doc, *.odt.
        Las pruebas las realizo con un correo que tiene un documento pdf y un documento doc.
        Tengo habilitadas las macros de outlook. He creado una regla sin lanzar script para comprobar que la regla se está ejecutando y se ejecuta.
        Si lanzo manualmente la regla con el script solo me imprime el doc.
        Si dejo que la regla con el script se ejecute automáticamente no imprime nada, ni lanza mensajes de error, ni nada de nada.

        Saludos y gracias!

        • me olvidé, cuando ejecuto la regla manualmente y me imprime 1 de los 2 documentos no me mueve ninguno de los adjuntos a la carpeta especificada.

          Saludos y gracias!

          • Buen dia Alex

            Realice un pequeño cambio en el codigo ahora se tienen que crear 2 directorios por ejemplo: C:Por Imprimir y C:Impresos, si deseas eliminar los archivos temporales de la carpeta Impresos debes eliminar el apostrofe de la linea 30.

            Comentas si ahora ya funciona.

            Saludos.

  4. Hola, primero de todo darte las gracias por tu desinteresada ayuda.

    Si dejo outlook desatendido no imprime y no mueve los archivos. Si cambio la regla de script a imprimir por ejemplo, si funciona la regla y me imprime el cuerpo del mail.

    Si fuerzo la regla manualmente, por ejemplo, para los no leidos, me imprime el documento DOC y lo copia a imprimir pero no lo mueve a impresos. El documento PDF ni lo imprime ni lo copia. Ambos están dentro del mismo mail.

    ¿hay alguna manera de saber que el script se está lanzando? no entiendo apenas VB, pero un ECHO o algún comando similar que muestre en pantalla que el script está corriendo, si más no para saber que pasa cuando outlook esta desatendido.

    Saludos y gracias de nuevo!

    • Buen dia Alex

      Claro, puedes añadir la siguiente linea después de declarar la funcion por ejemplo

      Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
      
      MsgBox "Script se ha ejecutado"
      
      ' Demas CODIGO AQUI
      
      End Sub

      También debes asegurarte que ningún otro modulo tenga el mismo nombre ya que no se ejecutaran.

      Saludos.

  5. Buem día! tengo un problema. Tengo mi cuenta personal de mi trabajo pero en ella tengo una cuenta compartida donde llegan las facturas y ese tipo de documentos. Y tengo que por medio de una macro todo los archivos xml y pdf se descarguen automaticamente. el detalle es que las macros que tengo solo realiza lo que quiero con mi cuenta personal con la que tengo compasrtida no realizada nada. Tengo Office 365. ya todo la informacion esta en la nube. Agradeceria mucho su ayuda. saludos

    • Buen dia Erik!

      Te debe permitir seleccionar el Mailbox para la cual ejecutar la regla que estas creando, en este caso debes crear dos reglas asi como configuraste para tu cuenta personal solo que en la segunda seleccionas el mailbox compartido.

      No te puedo dar mas detalles ya que no he utilizado Office 365.

      Saludos.

  6. perfecto ya supe como, ahora fernando
    crees que puedas ayudarme para que ahora en lugar de un archivo adjunto me descargue el body del correo?

  7. Gracias Fer ya vi como funciona, otra duda podrias ayudarme a que en lugar de un archivo adjunto ahora me descargue el body del correo ?? gracias

    • Buen dia Alejandro

      Prueba el siguiente código:

      Sub AutomaticallyPrintEmail(Item As Outlook.MailItem)
      Dim oApp As Outlook.Application
      Dim oNameSpace As Outlook.NameSpace
      Dim oTempMail As Outlook.MailItem
      Dim oInbox As Outlook.MAPIFolder
      Set oApp = Application
      Set oNameSpace = oApp.GetNamespace("MAPI")
      Set oInbox = oNameSpace.GetDefaultFolder(olFolderInbox)
      Set oTempMail = oApp.ActiveExplorer.CurrentFolder.Items.Add(olMailItem)
      
      oTempMail.BodyFormat = Item.BodyFormat
      oTempMail.Body = Item.Body
      oTempMail.PrintOut
      oTempMail.Delete
      Item.UnRead = False
      Set Item = Nothing
      Set oTempMail = Nothing
      Set oInbox = Nothing
      Set oNameSpace = Nothing
      Set oApp = Nothing
      End Sub

      Que tengas excelente dia.

  8. Muy buenas Fernando tengo esto para poder imprimir varios XLS que llegan a un Correo, funciona todo perfecto pero a la hora de cerrarse me dice que si quiero guardar, tengo que darle manualmente a que NO y seguidamente se abre el siguiene Excel, se imprime pero vuelve a pedir si guardar SI o NO, como son muchos hay alguna forma de que se cierre Automaticamente solo se imprime la Hoja1, te pongo el Código que tengo puesto:

    Public Sub PrintXLSEXCEL(itm As Outlook.mailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim FullFileName As String
    Dim objFSO As Object
    Dim WScript As Object
    Dim dteWait
    Dim wb As Workbook
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set WScript = CreateObject("WScript.Shell")
    Set objShell = CreateObject("Shell.Application")
    Set Inbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders.Item(".EXCEL")
    saveFolder = "C:\EXCEL"
    For Each objAtt In itm.Attachments
        If (InStr(UCase(objAtt.DisplayName), ".XLS")) Then
                  FullFileName = saveFolder & "\" & objAtt.DisplayName
                  objAtt.SaveAsFile (FullFileName)
                  'printAttachments saveFolder
                  Set objFolder = objShell.NameSpace(0)
                  Set printItem = objFolder.ParseName(FullFileName)
                  printItem.InvokeVerbEx ("Print")
                  itm.Close olDiscard
                  ' delay before move and delete
                  dteWait = DateAdd("s", 5, Now())
                  Do Until (Now() > dteWait)
                  Loop
                  For Each wb In Workbooks
                  wb.Save
                  Next
                  Application.Quit
        End If
    Next
    End Sub
  9. Buen día Fernando, Cómo puedo hacer para imprimir el contenido del correo envés de los adjuntos y como puedo enviarlo a dos impresoras diferentes? Muchas gracias, Saludos

    • Buen dia Carlos

      Para imprimir el cuerpo de correo revisa el siguiente código.

      Sub AutomaticallyPrintEmail(Item As Outlook.MailItem)
      Dim oApp As Outlook.Application
      Dim oNameSpace As Outlook.NameSpace
      Dim oTempMail As Outlook.MailItem
      Dim oInbox As Outlook.MAPIFolder
      Set oApp = Application
      Set oNameSpace = oApp.GetNamespace("MAPI")
      Set oInbox = oNameSpace.GetDefaultFolder(olFolderInbox)
      Set oTempMail = oApp.ActiveExplorer.CurrentFolder.Items.Add(olMailItem)
      
      oTempMail.BodyFormat = Item.BodyFormat
      oTempMail.Body = Item.Body
      oTempMail.PrintOut
      oTempMail.Delete
      Item.UnRead = False
      Set Item = Nothing
      Set oTempMail = Nothing
      Set oInbox = Nothing
      Set oNameSpace = Nothing
      Set oApp = Nothing
      End Sub

      Saludos.

  10. Buenos días Fernando, con lo que puse de guardar no me funciona y al final lo que me hace es cerrar el Microsoft Outlook 2010, no se si tendrá que ver el Office2010, porque cuando le doy a imprimir directamente al EXCEL lo abre perfectamete e imprime perfectamente, pero me sale el Dialogo de guardar SI, NO y CANCELAR. Sin embargo todo lo que llega en PDF lo imprime y cierra perfectamente.

    Gracias y Saludos.

    • Buen dia Felipe, Como tienes tu Script actual?

      Prueba eliminando o comenta lo antes mencionado, quedaría así, me comentas como funciona.

      Public Sub PrintXLSEXCEL(itm As Outlook.mailItem)
      Dim objAtt As Outlook.Attachment
      Dim saveFolder As String
      Dim FullFileName As String
      Dim objFSO As Object
      Dim WScript As Object
      Dim dteWait
      Dim wb As Workbook
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      Set WScript = CreateObject("WScript.Shell")
      Set objShell = CreateObject("Shell.Application")
      Set Inbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders.Item(".EXCEL")
      saveFolder = "C:\EXCEL"
      For Each objAtt In itm.Attachments
          If (InStr(UCase(objAtt.DisplayName), ".XLS")) Then
                    FullFileName = saveFolder & "\" & objAtt.DisplayName
                    objAtt.SaveAsFile (FullFileName)
                    'printAttachments saveFolder
                    Set objFolder = objShell.NameSpace(0)
                    Set printItem = objFolder.ParseName(FullFileName)
                    printItem.InvokeVerbEx ("Print")
                    itm.Close olDiscard
                    ' delay before move and delete
                    dteWait = DateAdd("s", 5, Now())
                    Do Until (Now() > dteWait)
                    Loop
                    'For Each wb In Workbooks
                    'wb.Save
                    'Next
                    'Application.Quit
          End If
      Next
      End Sub

      Saludos.

  11. Hola Fernando ante todo gracias por tu ayuda. He instalado el script para que me imprima los datos adjuntos PDF y funciona perfectamente pero cuando llega un correo con más de un archivo pdf sólo me imprime el primero. ¿puedes darme una solución? Gracias de nuevo.

    • Buen dia Pedro Bienvenido a PortalMasTips,

      El script esta escrito para imprimir todos los adjuntos, Lo he revisado nuevamente con 4 archivos PDFs y se imprimen.

      Puedes confirmar si te marca error? al igual de confirmar que en la carpeta Impresos.

      También puedes ajustar los tiempos de espera en las lineas dteWait = DateAdd(“s”, 5, Now()) el numero 5 es el tiempo de espera antes de proceder, puedes poner 2, 3 o mas segundos.

      Excelente dia

    • Buen día Ricardo

      La parte que realiza el proceso de impresión seria el siguiente.

      saveFolder = "C:\Imprimir"
      Set objFolder = objShell.NameSpace(0)
      Set printItem = objFolder.ParseName(FullFileName)
      printItem.InvokeVerbEx ("Print")

      En base a eso puedes generar el VBScript que requieras.

      Saludos.

  12. Buenas tardes Fernando,
    Muchas gracias por el script. pero me veo en la necessidad de imprimir por una impresora mapeada en el codigo y no por la predeterminada.
    adjunto script
    Public Sub Imprim_adjunto(itm As Outlook.MailItem)
    ‘ Declaramos las variables
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim FullFileName As String
    Dim objFSO As Object
    Dim WScript As Object
    Dim dteWait
    Set objFSO = CreateObject(“Scripting.FileSystemObject”)
    Set WScript = CreateObject(“WScript.Shell”)
    Set objShell = CreateObject(“Shell.Application”)
    ‘ Directorio donde Guardar los archivos
    saveFolder = “C:\Imprimir”
    ‘ Empezamos el bucle
    For Each objAtt In itm.Attachments
    If ((InStr(UCase(objAtt.DisplayName), “.DOC”) Or InStr(UCase(objAtt.DisplayName), “.DOCX”) Or InStr(UCase(objAtt.DisplayName), “.TXT”) Or InStr(UCase(objAtt.DisplayName), “.PDF”) Or InStr(UCase(objAtt.DisplayName), “.XLS”) Or InStr(UCase(objAtt.DisplayName), “.XlSX”))) Then
    FullFileName = saveFolder & “\” & objAtt.DisplayName
    objAtt.SaveAsFile (FullFileName)

    ‘ Definimos el nombre del documento adjunto a guardar y imprimimos
    Set objFolder = objShell.NameSpace(0)
    Set printItem = objFolder.ParseName(FullFileName)
    printItem.InvokeVerbEx (“Print”)

    ‘ delay before move and delete
    dteWait = DateAdd(“s”, 5, Now())
    Do Until (Now() > dteWait)
    Loop

    End If
    Next
    End Sub

    Un Saludo y muchas gracias

    • Buen dia Carles

      Forma que conozca para envía a una impresora no predeterminada especificando en el código no conozco, lo que se realiza es cambiar la impresora predeterminada temporalmente y al finalizar el proceso regresar nuevamente la predeterminada, el código para realizar el cambio de impresora es:

      Dim strPrinterName
      Dim objWMI
      Dim colPrinters
      Dim WshNetwork
      
      strPrinterName = "Nombre exacto de impresora"
      
      Set WshNetwork = CreateObject("Wscript.Network")
      set objWMI = GetObject("winmgmts:\\.\root\cimv2")
      
      set Printers = objWMI.ExecQuery("Select * From Win32_Printer")
      
      Dim Printer
      For Each Printer In Printers
      	If Printer.Name = strPrinterName Then
      		WshNetwork.SetDefaultPrinter strPrinterName
      	End If
      Next

      Debes ingresar el nombre exacto de la impresora de lo contrario no realizara el cambio al no encontrarla.

      Excelente dia.

      • Fernando Perfecto el script para cambiar la impresora predeterminada.
        Ya para rizar el rizo desde el script comentado en el post para imprimir adjuntos se podria añadir una linea para que imprima la cabecera del correo? lo tengo configurado desde Outlook pero lo imprime por la impresora predeterminada.
        Un Saludos y Gracias por tu respuesta!

          • Buen dia Carles

            Puedes agregar el siguiente código el cual imprime el correo lo puedes poner despues de cambiar la impresora predeterminada.

            Dim oTempMail As Outlook.MailItem
            Dim oApp As Outlook.Application
            Dim oNameSpace As Outlook.NameSpace
            Dim oInbox As Outlook.MAPIFolder
            Set oApp = Application
            Set oNameSpace = oApp.GetNamespace("MAPI")
            Set oInbox = oNameSpace.GetDefaultFolder(olFolderInbox)
            Set oTempMail = oApp.ActiveExplorer.CurrentFolder.Items.Add(olMailItem)
            
            oTempMail.BodyFormat = itm.BodyFormat
            oTempMail.Body = itm.Body
            itm.PrintOut

            Saludos.

Deja un comentario...

Compartir
Twittear
+1
Compartir
Pin
Stumble