Private Sub CommandButton1_Click()
Const DateiPfad = "N:\PLWSM3_ALLGEMEIN"
Dim vntFile As Variant
vntFile = Application.GetSaveAsFilename(DateiPfad & "\" & ActiveSheet.Range("B11").Value & "_" & _
ActiveSheet.Range("AA5").Value & "_" & _
ActiveSheet.Range("B19").Value & "_" & _
ActiveSheet.Range("AA2").Value & ".pdf", "PDF Dateien (*.pdf), *.pdf", Title:="Als PDF Speichern")
If vntFile <> False Then
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=vntFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
Dim OutApp As Object
Dim OutMail As Object
Dim data As String
data = BerichtToPDF
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Range("b25").Text
.CC = ""
.BCC = ""
.Subject = Range("aa7").Text
.HTMLBody = Range("aa9").Text
.Attachment.Add (data)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Range("h244").Value = "OK"
End Sub