Mailanhänge ausdrucken

Private Sub CBAnfragemaildrucken_Click() Dim olApp As Object 'AktMail As Object, Set olApp = CreateObject("Outlook.Application") 'OutlookVerweis If Not olApp.ActiveInspector Is Nothing Then 'Pruefung auf offene Mail With olApp.ActiveInspector.CurrentItem() .PrintOut 'Aktuelle Mail drucken End With Else MsgBox "Es gibt keine offene Mail zum Drucken" End If Set olApp = Nothing End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Rolf,
teste mal:

Option Explicit

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

Private Const SW_HIDE As Long = 0

Private Sub CBAnfragemaildrucken_Click()

    Dim olApp As Object, objAttachment As Object 'AktMail As Object,
    Dim strPath As String

    Set olApp = CreateObject(Class:="Outlook.Application") 'OutlookVerweis

    If Not olApp.ActiveInspector Is Nothing Then 'Pruefung auf offene Mail

        With olApp.ActiveInspector.CurrentItem()

            .PrintOut 'Aktuelle Mail drucken

            For Each objAttachment In .Attachments

                With objAttachment

                    strPath = Environ$("tmp") & "\" & .Filename

                    Call .SaveAsFile(strPath)

                    Call ShellExecuteA(Application.hwnd, "PRINT", strPath, vbNullString, vbNullString, SW_HIDE)

                    Call Kill(PathName:=strPath)

                End With
            Next
        End With

    Else
        MsgBox "Es gibt keine offene Mail zum Drucken"
    End If

    Set olApp = Nothing

End Sub

Gruß
Nepumuk

Hallo Rolf,
teste mal:

Option Explicit

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

Private Const SW_HIDE As Long = 0

Private Sub CBAnfragemaildrucken_Click()

    Dim olApp As Object, objAttachment As Object 'AktMail As Object,
    Dim strPath As String

    Set olApp = CreateObject(Class:="Outlook.Application") 'OutlookVerweis

    If Not olApp.ActiveInspector Is Nothing Then 'Pruefung auf offene Mail

        With olApp.ActiveInspector.CurrentItem()

            .PrintOut 'Aktuelle Mail drucken

            For Each objAttachment In .Attachments

                With objAttachment

                    strPath = Environ$("tmp") & "\" & .Filename

                    Call .SaveAsFile(strPath)

                    Call ShellExecuteA(Application.hwnd, "PRINT", strPath, vbNullString, vbNullString, SW_HIDE)

                    Call Application.OnTime(EarliestTime:=Now + TimeSerial(0, 0, 10), _
                        Procedure:="'KillFile """ & strPath & """'", Schedule:=True)

                End With
            Next
        End With

    Else
        MsgBox "Es gibt keine offene Mail zum Drucken"
    End If

    Set olApp = Nothing

End Sub

Private Sub KillFile(ByVal pvstrPath As String)
    Call Kill(PathName:=pvstrPath)
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread