Hallo und Guten Tag,

Und zwar habe ich folgendes Problem:

Ich habe in Outlook einen Ordner in denen bestimmte E-Mails mit PDF Anhang mit einer Regel automatisch landen. Dieser heist Arbeitsnachweise.

Hinter jeder E-Mail hängt also eine PDF mit dem Namen "Arbeitsnachweis". Da wir diese drucken müssen und das auch mal 50 am Tag sein können, möchte ich das ganze über ein Script drucken lassen. Ich hatte auch ein Script das vielversprechend aussah und im Prizip auch das gemacht hat. Bloß ist das Problem das der Anhang immer gleich heisst, also "Arbeitsnachweis". Also hat er mir nicht wie gewünscht von 50 E-Mails jeweils den Anhang gedruckt, sondern einen Anhang aus einer E-Mail gleich 50 mal.

Hat jemand eine Idee oder vielleicht ein Script damit dies funktioniert? Unten seht ihr das von mir verwendete Script

Ich bedanke mich jetzt schon einmal für eure Hilfe

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:\Attachments"

  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