Bilder Mail Attachments drucken

  • Outlook

Es gibt 23 Antworten in diesem Thema. Der letzte Beitrag () ist von Sam85.

    Was steht in "attachment_directory"? Mal ins Blaue: strFile = attachment_directory & "\" & otlAtt.FileName

    Edit:
    Nimm mal "On Error Resume Next" raus. Und am Anfang des Moduls die Anweisung Option Explicit setzen. Dann wirst Du sehen wo die Probleme liegen könnten. "attachment_directory" ist nicht deklariert, und somit leer.

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „mumpel“ ()

    Ja ich habe mich vorhin auch schon gefragt, was Attachment_Directory ist und wie es deklariert werden soll. Hier ist der Link wo ich es gefunden habe.
    Oder stellt Attachment_Directory einfach nur den Default Pfad da? Bzw. kann ich einfach einen Pfad hinterlegen?

    Weshalb nutzt Du nicht "strFilePath" (hast Du ja am Anfang des Codes angegeben) anstelle von "Attachment_Directory"? Oder Du gibst den Pfad direkt an.

    "Attachment_Directory" ist vermutlich ein Überbleibsel aus einer alten Outlookversion.

    Das mit FilePath habe ich versucht, da kommt aber nichts raus...deshalb hat mich das auch stutzig gemacht.
    Hab es jetzt mal ganz weggelassen...im festgelegten Verzeichnis stehen sie jetzt drin und drucken geht auch.
    Mal schauen was bei einen anderen Benutzer passiert.

    EDIT:
    Muss jetzt nur den Timer etwas höher setzen, damit die Dateien nicht zu schnell zerstört werden.
    Spoiler anzeigen


    Visual Basic-Quellcode

    1. Option Explicit
    3. #If VBA7 Then
    4. Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
    5. ByVal hwnd As LongPtr, _
    6. ByVal lpOperation As String, _
    7. ByVal lpFile As String, _
    8. ByVal lpParameters As String, _
    9. ByVal lpDirectory As String, _
    10. ByVal nShowCmd As LongPtr) As LongPtr
    12. Public Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As LongPtr)
    13. #Else
    14. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
    15. ByVal hwnd As Long, _
    16. ByVal lpOperation As String, _
    17. ByVal lpFile As String, _
    18. ByVal lpParameters As String, _
    19. ByVal lpDirectory As String, _
    20. ByVal nShowCmd As Long) As Long
    22. Public Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
    23. #End If
    25. Const strFilePath As String = "C:\Anlagen"



    Visual Basic-Quellcode

    1. Public Sub PrintSelectedAttachments()
    2. Dim otlExplorer As Outlook.Explorer
    3. Dim otlSelection As Outlook.Selection
    4. Dim obj As Object
    6. Set otlExplorer = Application.ActiveExplorer
    7. Set otlSelection = otlExplorer.Selection
    9. For Each obj In otlSelection
    10. If TypeOf obj Is Outlook.MailItem Then PrintAttachments obj
    11. Next
    13. Set otlSelection = Nothing
    14. Set otlExplorer = Nothing
    16. Sleep 5000
    17. Shell "TaskKill /im acrobat.exe /f"
    18. Shell "TaskKill /im acrord32.exe /f"
    19. Kill (strFilePath & "\*.*")
    20. End Sub



    Visual Basic-Quellcode

    1. Private Sub PrintAttachments(ByVal otlMail As Outlook.MailItem)
    2. Dim otlAttCounter As Outlook.Attachments
    3. Dim otlAtt As Outlook.Attachment
    4. Dim strFile As String
    5. Dim strFileType As String
    7. On Error Resume Next
    9. If Dir(strFilePath, vbDirectory) = "" Then MkDir (strFilePath)
    11. Set otlAttCounter = otlMail.Attachments
    13. If otlAttCounter.Count Then
    14. For Each otlAtt In otlAttCounter
    15. strFileType = LCase$(Right$(otlAtt.FileName, 4))
    16. Select Case strFileType
    17. Case ".xls", ".xlsx", ".doc", ".docx", ".pdf"
    18. strFile = otlAtt.FileName
    19. otlAtt.SaveAsFile (strFile)
    20. ShellExecute 0, "print", strFile, vbNullString, vbNullString, 0
    21. Case ".tif", ".jpg", ".jpeg", ".png"
    22. strFile = otlAtt.FileName
    23. otlAtt.SaveAsFile (strFile)
    24. Shell "C:\Program Files\IrfanView\i_view64.exe " & """" & strFilePath & "\" & strFile & """" & " /print=" & GetDefaultPrinterByName()
    25. End Select
    26. Next otlAtt
    27. End If
    29. Set otlAttCounter = Nothing
    30. End Sub



    Visual Basic-Quellcode

    1. Option Explicit
    3. #If VBA7 Then
    4. Private Declare PtrSafe Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" ( _
    5. ByVal lpAppName As String, _
    6. ByVal lpKeyName As String, _
    7. ByVal lpDefault As String, _
    8. ByVal lpReturnedString As String, _
    9. ByVal nSize As Long) As Long
    10. #Else
    11. Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" ( _
    12. ByVal lpAppName As String, _
    13. ByVal lpKeyName As String, _
    14. ByVal lpDefault As String, _
    15. ByVal lpReturnedString As String, _
    16. ByVal nSize As Long) As Long
    17. #End If
    19. Public Function GetDefaultPrinterByName() As String
    20. Dim strBuffer As String
    21. Dim lngBuffer As Long
    22. Dim lngReturn As Long
    24. strBuffer = Space(8192)
    25. lngReturn = GetProfileString("windows", "device", "", strBuffer, Len(strBuffer))
    27. If lngReturn Then
    28. strBuffer = Mid$(strBuffer, 1, lngReturn)
    29. lngBuffer = InStr(strBuffer, ",")
    30. GetDefaultPrinterByName = Mid$(strBuffer, 1, lngBuffer - 1)
    31. Else
    32. GetDefaultPrinterByName = ""
    33. End If
    34. End Function


    Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von „Sam85“ ()

Facebook
Telefonspende