☰

Outlook VBA-Scripting – Anhänge drucken und E-Mails verschieben

tag-icon • tag-icon email microsoft-outlook vba printing
Outlook VBA-Scripting – Anhänge drucken und E-Mails verschieben

Ich bin neu im VB-Scripting und brauche daher viel Hilfe.

Eine kürzliche Änderung an einem E-Mail-Konto bedeutet, dass empfangene E-Mails gemäß einer Regel, die ich nicht eingegeben habe und nicht ändern kann, in einen anderen Ordner als den Posteingang verschoben werden. Nennen wir ihn Ordner_X.

Ich versuche, Anhänge automatisch aus allen E-Mails zu drucken, die in Ordner_X eingehen und einen Anhang haben. Sobald der Anhang gedruckt ist, verschieben Sie die E-Mail in einen anderen Ordner (Ordner_Y). E-Mails ohne Anhang sollten nicht verschoben werden.

Bisher konnte ich eine Regel auf eingehende E-Mails anwenden, indem ich sie in Ordner_Y verschob, wenn sie einen Anhang enthielten, und das folgende Skript ausführte, das ich im Internet gefunden hatte, um den Anhang auszudrucken. Aber mit dieser neuen Regelkonfiguration, zu der ich keinen Einfluss habe, kann ich die vorherige Regel nicht mehr verwenden, da Regeln nur auf eingehende/ausgehende E-Mails und nicht auf E-Mails, die sich bereits in einem Ordner (Ordner_X) befinden, angewendet werden.

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

Ich bin für alle Vorschläge dankbar, wie dieses Skript für die Arbeit mit einem Ordner angepasst werden kann oder wie eine alternative Vorgehensweise aussieht.

Antwort1

Sie können das ItemAdd-Ereignis verwenden, um Code auszuführen, nachdem ein Element in einen Ordner gelangt ist.

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

verwandte Informationen