Sub
Schaltfläche2_Klicken()
Dim
strMailAdresse
As
String
Dim
LKNR
As
String
strMailAdresse = Worksheets(
"QSYS"
).Range(
"B33"
).Value
LKNR = Worksheets(
"QSYS"
).Range(
"B4"
).Value
Worksheets(
"DE"
).ExportAsFixedFormat Type:=xlTypePDF, Filename:=
"C:\Users\" & Environ("
username
") & "
\AppData\Local\Temp\
" & Format(Date, "
YYYY-MM-DD
") & "
" & Format(Time, "
hh-mm
") & "
_Wareneingang.pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=
True
, IgnorePrintAreas _
:=
False
strPDF =
"C:\Users\" & Environ("
username
") & "
\AppData\Local\Temp\
" & Format(Date, "
YYYY-MM-DD
") & "
" & Format(Time, "
hh-mm
") & "
_Wareneingang_ZA.pdf"
Set
olApp = CreateObject(
"Outlook.Application"
)
With
olApp.CreateItem(0)
.SentOnBehalfOfName =
"test@test.de"
.
To
= strMailAdresse
.Subject = LKNR &
" Bestätigung Wareneingang"
.Attachments.Add strPDF
.HTMLBody =
"<HTML> <font face=+Textkörper>For english see below <br>"
_
&
"<br> "
_
&
"************************************* <br>Sehr geehrter Kunde <br>"
_
&
"<br> "
_
& "Hiermit bestätigen wir ihnen die Warenrücklieferung zur _
&
"</font face> </HTML>"
.Display
End
With
Kill strPDF
Set
olApp =
Nothing
MsgBox
"Mail wurde versendet"
, vbOKOnly,
"Mail versendet"
Dim
Speicherpfad
As
String
Dim
o2App
As
Object
, objMail
As
Object
LKNR = Worksheets(
"QSYS"
).Range(
"B4"
).Value
Speicherpfad = "C:\Ablageort\"
Set
o2App = GetObject(,
"OutLook.Application"
)
Set
objMail = o2App.Session.GetDefaultFolder(5).Items.GetLast
objMail.SaveAs Speicherpfad & Format(
Date
,
"yyyy"
) &
"_"
& Format(
Date
,
"mm"
) &
"_"
& Format(
Date
,
"dd"
) &
"_"
& LKNR &
".msg"
, 3
ThisWorkbook.Close savechanges:=
False
Application.Quit
End
Sub