Public Sub TabelleAlsPdf()
Dim olApp As Object
Dim AWS As String
Dim VarAWSPDF As String
Dim olOldBody As String
Dim strAddress As String
Dim VarKW As String
Dim VarJahr As String
Dim i As Integer
Rem Pfad für PDF festlegen
VarKW = Tabelle1.Cells(2, 3)
VarJahr = Tabelle1.Cells(2, 2)
AWS = "V:\winhebuabrech\Preismitteilung\Preismitteilung KW " & VarKW & ", " & VarJahr
VarAWSPDF = AWS & ".pdf"
Rem Empfängerliste zusammenstellen
For i = 1 To Tabelle12.Range("A" & Rows.Count).End(xlUp).Row
If strAddress = "" Then
strAddress = Tabelle12.Cells(i, 1)
Else
strAddress = strAddress & ";" & Tabelle12.Cells(i, 1)
End If
Next i
Rem Tabelle2 als PDF speichern
Worksheets("Preismitteilung").PageSetup.CenterHorizontally = True
Worksheets("Preismitteilung").PageSetup.Orientation = xlPortrait
Worksheets("Preismitteilung").PageSetup.Zoom = 110
Worksheets("Preismitteilung").PageSetup.LeftMargin = Application.InchesToPoints(0.8)
Tabelle11.Range("a1:h50").ExportAsFixedFormat Type:=xlTypePDF, Filename:=AWS, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.GetInspector.Display
.To = strAddress
.Subject = "Preismitteilung"
.Body = "Sehr geehrte Damen und Herren," & Chr(10) & Chr(10) & "im Anhang finden Sie die Preismitteilung für die KW " & VarKW & " des Jahres " & VarJahr & "." & Chr(10) & Chr(10) & "Mit freundlichen Grüßen" & Chr(10)
.Attachments.Add VarAWSPDF
.Display
End With
End Sub