Option
Explicit
Sub
Mail_Senden_mit_PDF()
Dim
WSh
As
Worksheet
Dim
sMailtext
As
String
, sSignatur
As
String
Dim
sDateiName
As
String
, T
As
String
Set
WSh = ThisWorkbook.Sheets(
"Tabelle1"
)
sDateiName = ThisWorkbook.FullName
sDateiName = Left$(sDateiName, InStrRev(sDateiName,
"."
)) &
"pdf"
T = ThisWorkbook.Path & "\"
sDateiName = Replace(sDateiName, T, T & WSh.Range(
"B4"
).Value &
"_"
)
ThisWorkbook.Sheets(
"Furnierte Platten"
).ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sDateiName, Quality:=xlQualityStandard, _
IncludeDocProperties:=
True
, _
IgnorePrintAreas:=
False
, OpenAfterPublish:=
False
With
CreateObject(
"Outlook.Application"
).CreateItem(0)
.BodyFormat = 2
.Subject =
"Bestellung "
& WSh.Range(
"B4"
).Value
.
To
= Replace(WSh.Range(
"E9"
).Value, vbLf,
";"
)
sMailtext =
"Guten Tag,"
& vbLf & vbLf &
"Im Anhang sende ich Ihnen die Bestellung für Auftrag "
_
& WSh.Range(
"B4"
).Value &
"."
& vbLf &
"Gerne erwarte ich Ihre Bestätigung."
& vbLf
.GetInspector: sSignatur = .HTMLBody
.HTMLBody = Replace(sMailtext, vbLf,
"<br>"
) & sSignatur
.Display
If
Dir$(sDateiName) <>
""
Then
.Attachments.Add sDateiName
End
If
End
With
End
Sub