☰

Secuencias de comandos de Outlook VBA: imprimir archivos adjuntos y mover correos electrónicos

tag-icon • tag-icon email microsoft-outlook vba printing
Secuencias de comandos de Outlook VBA: imprimir archivos adjuntos y mover correos electrónicos

Soy nuevo en las secuencias de comandos VB, así que necesito mucha ayuda.

Un cambio reciente en una cuenta de correo electrónico significa que los correos electrónicos recibidos se movieron a una carpeta distinta a la bandeja de entrada mediante una regla que no ingresé y no puedo cambiar, llamémosla Carpeta_X.

Lo que intento hacer es imprimir automáticamente los archivos adjuntos de cualquier correo electrónico que llegue a Folder_X y que tenga un archivo adjunto. Una vez impreso el archivo adjunto, mueva el correo electrónico a otra carpeta (Carpeta_Y). Cualquier correo electrónico que no tenga un archivo adjunto no debe moverse.

Anteriormente podía usar una regla en el correo entrante, moviéndolo a Folder_Y si tenía un archivo adjunto y ejecutando el siguiente script que encontré en Internet para imprimir el archivo adjunto. Pero con esta nueva configuración de reglas en la que no tengo participación, ya no puedo usar la regla anterior ya que las reglas solo funcionan en el correo entrante/saliente y no en el correo que ya está en una carpeta (Carpeta_X).

Sub LSPrint(Item As Outlook.MailItem)
    On Error GoTo OError

    'detect Temp
    Dim oFS As FileSystemObject
    Dim sTempFolder As String

    Set oFS = New FileSystemObject
    'Temporary Folder Path
    sTempFolder = oFS.GetSpecialFolder(TemporaryFolder)
    'creates a special temp folder
    cTmpFld = sTempFolder & "\OETMP" & Format(Now, "yyyymmddhhmmss")
    MkDir (cTmpFld)

    'save & print
    Dim oAtt As Attachment

    For Each oAtt In Item.Attachments
      FileName = oAtt.FileName
      FullFile = cTmpFld & "\" & FileName

      'save attachment
      oAtt.SaveAsFile (FullFile)

      'print attachment
      Set objShell = CreateObject("Shell.Application")
      Set objFolder = objShell.NameSpace(0)
      Set objFolderItem = objFolder.ParseName(FullFile)
      objFolderItem.InvokeVerbEx ("print")
    Next oAtt

    'Cleanup

    If Not oFS Is Nothing Then Set oFS = Nothing
    If Not objFolder Is Nothing Then Set objFolder = Nothing
    If Not objFolderItem Is Nothing Then Set objFolderItem = Nothing
    If Not objShell Is Nothing Then Set objShell = Nothing

OError:

    If Err <> 0 Then
      MsgBox Err.Number & " - " & Err.Description
      Err.Clear
    End If

    Exit Sub
End Sub

Cualquier sugerencia sobre cómo adaptar este script para que funcione en una carpeta o una forma alternativa de hacerlo será muy apreciada.

Respuesta1

Puede utilizar el evento ItemAdd para ejecutar código después de que un elemento ingresa a una carpeta.

Option Explicit

'  In ThisOutlookSession
Private WithEvents addedItems As Items

Private Sub Application_Startup()
    ' Add as many  .folders(subfolder name) as is needed to navigate to the folder
    Set addedItems = Session.GetDefaultFolder(olFolderInbox).folders("folder_X").Items
End Sub

Private Sub addedItems_ItemAdd(ByVal Item As Object)

    Dim oAtt As attachment

    If Item.Attachments.count > 0 Then

        Debug.Print "Processing " & Item.subject

        For Each oAtt In Item.Attachments
            Debug.Print "Processing attachment."
        Next oAtt

        Item.move Session.GetDefaultFolder(olFolderInbox).folders("folder_Y")

    End If

End Sub

información relacionada