VBA Hilfe

Sub UATEmailReportingexcelundpdfHTmLAuto() '** Dimensionierung der Variablen Dim strPDF As String Dim OutlookApp As Object, strEmail As Object Dim olOldbody As String Dim olApp As Object Dim AWS As String '** Vorgaben definieren Set OutlookApp = CreateObject("Outlook.Application") Set strEmail = OutlookApp.CreateItem(0) AWS = Environ("USERPROFILE") & "\Desktop\Reporting-Outbound.xlsx" '** PDF erzeugen ThisWorkbook.Sheets("Outbound").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ ThisWorkbook.Path & "\UserAcceptanceTestReport.pdf", Quality:=xlQualityStandard _ , IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish _ :=False '** Excel erzeugen ThisWorkbook.Sheets(Array("Outbound")).Copy Application.DisplayAlerts = False With ActiveWorkbook .SaveAs Filename:=AWS, FileFormat:=xlOpenXMLWorkbook .Close savechanges:=False End With Application.DisplayAlerts = True '** E-Mail versenden strPDF = ThisWorkbook.Path & "\Reporting-Outbound.pdf" Set olApp = CreateObject("Outlook.Application") With olApp.CreateItem(0) With strEmail .Attachments.Add strPDF .Attachments.Add AWS .To = "" .Subject = "1000erKunden-Outbound-Report Stand:" & Range("AA1") .GetInspector olOldbody = .htmlBody .BodyFormat = 2 'olFormatHTML .htmlBody = " Hallo Zusammen, " _ & "anbei das aktuelle Outbound-Reporting inkl. aller Kundenreaktionen im Anhang. " _ & "Sollten sich Rückfragen zu dem Thema ergeben, gerne melden. " _ & olOldbody .Display '.Send 'Damit wir die E-Mail sofort versendet ' Kill strPDF End With '** Objektvariablen wieder löschen Set OutlookApp = Nothing Set strEmail = Nothing End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA Hilfe

20.02.2023 13:40:49

sam

AW: VBA Hilfe

20.02.2023 18:42:57

ralf_b

AW: VBA Hilfe

21.02.2023 19:04:16

Yal

Sub UATEmailReporting2excelundpdfHTmLAuto() '** Dimensionierung der Variablen Dim strPDF As String Dim OutlookApp As Object, strEmail As Object Dim olOldbody As String Dim olApp As Object Dim AWS As String '** Vorgaben definieren Set OutlookApp = CreateObject("Outlook.Application") Set strEmail = OutlookApp.CreateItem(0) AWS = Environ("USERPROFILE") & "\Desktop\Reporting-Outbound.xlsx" '** PDF erzeugen ThisWorkbook.Sheets("Outbound").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ ThisWorkbook.Path & "\Reporting-Outbound.pdf", Quality:=xlQualityStandard _ , IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish _ :=False '** Excel erzeugen ThisWorkbook.Sheets("Outbound").Range("A1:O" & Sheets("Outbound").Cells(Rows.Count, 1).End(xlUp).Row).Copy Application.DisplayAlerts = False With ActiveWorkbook .SaveAs Filename:=AWS, FileFormat:=xlOpenXMLWorkbook .Close savechanges:=False End With Application.DisplayAlerts = True '** E-Mail versenden strPDF = ThisWorkbook.Path & "\Reporting-Outbound.pdf" Set olApp = CreateObject("Outlook.Application") With olApp.CreateItem(0) With strEmail .Attachments.Add strPDF .Attachments.Add AWS .To = "bboehner@dela.de; kmehner@dela.de" .Subject = "1000erKunden-Outbound-Report Stand:" & Range("AA1") .GetInspector olOldbody = .htmlBody .BodyFormat = 2 'olFormatHTML .htmlBody = " Hallo Zusammen, " _ & "anbei das aktuelle Outbound-Reporting inkl. aller Kundenreaktionen im Anhang. " _ & "Sollten sich Rückfragen zu dem Thema ergeben, gerne melden. " _ & olOldbody .Display '.Send 'Damit wir die E-Mail sofort versendet ' Kill strPDF End With '** Objektvariablen wieder löschen Set OutlookApp = Nothing Set strEmail = Nothing End With End Sub

Hallo Sam,
wenn Du intensiv mit einer Bibliothek arbeitest, ist es dann sinnvoll, diese "anzubinden": in VB-Editor unter "Extras", "Verweise...", Haken bei "Microsoft Outlook 16 Object Library" setzen. So hast Du den IntelliSense, d.h. die Vorschläge für Methode und Eigenschaften von Outlook-Objekte und auch die Outlook-Objekte in dem Objekt-Katalog.
Wenn Du die Variable an der richtige Stelle verwendest, ergibt sich mehr Sinn und weniger Wiederholung: "olAPP" und "OutlookApp" sind eigentlich dasselbe. Kein Grund 2 Variable zu verwenden. strPDF (den ich als "PfadPDF" sprechender finde, aber nur meine Meinung) könnte am Anfang definiert werden und schon beim Speichern verwendet werden.
Achte auf das Einrücken: jeder Blockinhalt "With", "If", "For" eine Stelle nach rechts bis Blockende.
Hier dein Code "bereinigt":
(den ".Copy" ohne "Paste" habe ich drin gelassen, hat aber keine Wirkung)

Sub UATEmailReporting2excelundpdfHTmLAuto()
'Unter Anbindung ("Extras", "Verweise...") der Bibliothek "Microsoft Outlook 16 Object Library"
Dim PfadPDF As String
Dim OutlookApp As New Outlook.Application 'Instanzierung bei der Deklaration
Dim Email As MailItem
Dim olOldbody As String
Dim PfadAWS As String
'** PDF erzeugen
    PfadPDF = ThisWorkbook.Path & "\Reporting-Outbound.pdf"
    ThisWorkbook.Sheets("Outbound").ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=strPDF, Quality:=xlQualityStandard, _
        IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
  
'** Excel erzeugen
    PfadAWS = Environ("USERPROFILE") & "\Desktop\Reporting-Outbound.xlsx"
    With ThisWorkbook.Sheets("Outbound")
        Range(.Range("O1"), .Cells(Rows.Count, 1).End(xlUp)).Copy 'Copy ohne Paste?
        
        Application.DisplayAlerts = False
        With ActiveWorkbook
            .SaveAs Filename:=AWS, FileFormat:=xlOpenXMLWorkbook
            .Close savechanges:=False
        End With
        Application.DisplayAlerts = True
    End With
    
'** E-Mail versenden
    Set Email = OutlookApp.CreateItem(olMailItem)
    With Email
        .Attachments.Add PfadPDF
        .Attachments.Add PfadAWS
        .To = "bboehner@dela.de; kmehner@dela.de"
        .Subject = "1000erKunden-Outbound-Report Stand:" & Range("AA1")
        .GetInspector
        olOldbody = .htmlBody
        .BodyFormat = 2 'olFormatHTML
        .htmlBody = " Hallo Zusammen," & vbLf & vbLf _
            & "anbei das aktuelle Outbound-Reporting inkl. aller Kundenreaktionen im Anhang." & vbLf _
            & "Sollten sich Rückfragen zu dem Thema ergeben, gerne melden. " & vbLf _
            & olOldbody
        .Display
        '.Send 'Damit wir die E-Mail sofort versendet
    End With
    ' Kill PfadPDF
  
'** Objektvariablen wieder löschen
    Set OutlookApp = Nothing
    Set Email = Nothing
End Sub

VG
Yal

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread