Anlagen automatisch drucken

Automatisch bei Emaileingang drucken

Sie können Anlagen, die Sie per E-Mail erhalten, sofort ausdrucken lassen. Voraussetzung dafür ist, dass auf Ihrem PC eine Anwendung installiert ist, die mit dem jeweiligen Dateityp umgehen kann, also z.B. Microsoft Word für Word-Dokumente (*.doc) und dass der Drucker eingeschaltet ist.

In der PrintAttachments-Funktion sehen Sie im Select Case-Statement, dass Excel-Arbeitsmappen (*.xls), Word- (*.doc) und PDF-Dokumente gedruckt werden. Die Liste können Sie um beliebige Dateitypen erweitern.

Damit eine Anlage gedruckt werden kann, muss das Makro diese zuerst als Datei speichern. Das Verzeichnis zum Speichern der Anlage wird in der Variable sDirectory angegeben. Geben Sie dort ein Verzeichnis an, dass bereits existiert.

  So fügen Sie Makros in Outlook ein

Private Declare Function ShellExecute Lib "shell32.dll" Alias _
  "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
  ByVal lpFile As String, ByVal lpParameters As String, _
  ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
  Dim Ns As Outlook.NameSpace
  Dim Folder As Outlook.MAPIFolder

  Set Ns = Application.GetNamespace("MAPI")
  Set Folder = Ns.GetDefaultFolder(olFolderInbox)
  Set Items = Folder.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
  If TypeOf Item Is Outlook.MailItem Then
    PrintAttachments Item
  End If
End Sub

Private Sub PrintAttachments(oMail As Outlook.MailItem)
  On Error Resume Next
  Dim colAtts As Outlook.Attachments
  Dim oAtt As Outlook.Attachment
  Dim sFile As String
  Dim sDirectory As String
  Dim sFileType As String

  sDirectory = "D:\Anlagen"

  Set colAtts = oMail.Attachments

  If colAtts.Count Then
    For Each oAtt In colAtts

      sFileType = LCase$(right$(oAtt.FileName, 4))

      Select Case sFileType
      Case ".xls", ".doc", ".pdf"
        sFile = ATTACHMENT_DIRECTORY & oAtt.FileName
        oAtt.SaveAsFile sFile
        ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
      End Select
    Next
  End If
End Sub

Anlagen ausgewählter Emails drucken

Dieses Beispiel druckt nicht automatisch bei Eingang einer neuen Email, sondern muss manuell aufgerufen werden und druckt dann die Anlagen aller ausgewählten Emails. Bezüglich der Anpassung (welche Dateien drucken und wo speichern) gelten die gleichen Bedingungen wie im ersten Beispiel.

Private Declare Function ShellExecute Lib "shell32.dll" Alias _
  "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
  ByVal lpFile As String, ByVal lpParameters As String, _
  ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Sub PrintSelectedAttachments()
  Dim Exp As Outlook.Explorer
  Dim Sel As Outlook.Selection
  Dim obj as Object
  Set Exp = Application.ActiveExplorer
  Set Sel = Exp.Selection
  For Each obj in Sel
    If TypeOf obj is Outlook.MailItem Then
      PrintAttachments obj
    EndIf
  Next
End Sub

Private Sub PrintAttachments(oMail As Outlook.MailItem)
  On Error Resume Next
  Dim colAtts As Outlook.Attachments
  Dim oAtt As Outlook.Attachment
  Dim sFile As String
  Dim sDirectory As String
  Dim sFileType As String

  sDirectory = "D:\Anlagen"

  Set colAtts = oMail.Attachments

  If colAtts.Count Then
    For Each oAtt In colAtts

      sFileType = LCase$(right$(oAtt.FileName, 4))

      Select Case sFileType
      Case ".xls", ".doc", ".pdf"
        sFile = ATTACHMENT_DIRECTORY & oAtt.FileName
        oAtt.SaveAsFile sFile
        ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
      End Select
    Next
  End If
End Sub