Option
Explicit
Sub
Versand_Rechnungen()
Dim
Empfänger, CC, BCC, Verzeichnis, Filename, Pfad
As
String
Dim
Mail
As
MailItem
Dim
popup
As
Object
Set
popup = CreateObject(
"shell.application"
)
Set
Verzeichnis = popup.BrowseForFolder(0,
"Aus welchem Verzeichnis sollen die Rechnungen kommen?"
, &H1, 0)
Pfad = Verzeichnis.Self.Path
Empfänger =
"mustermann@gmail.de"
Filename = Dir(Pfad &
"\*.pdf"
)
Do
While
Filename >
""
Set
Mail = Application.CreateItem(olMailItem)
With
Mail
.
To
= Empfänger
.Subject =
"Rechnungen: "
& Filename
.Body =
"Sehr geehrte Damen und Herren,"
& vbLf _
& vbLf _
&
"anbei finden Sie die Rechnung "
& Filename &
" zur weiteren Verarbeitung und korrigiert um die festgestellten Darstellungsfehler"
& vbLf _
& vbLf _
& "Bitte beachten Sie, dass in diesem Monat erstmalig die Verrechnung mit einer neuen Version unserer genutzten Software erfolgt ist.
Trotz intensiver Tests und Prüfungen, können dennoch Fehler aufgetreten sein. Sofern Sie daher einen Fehler entdecken sollten, melden Sie
diesen gerne und wir werden eine entsprechende
Korrektur im kommenden Monat vornehmen." & vbLf _
& vbLf _
&
"Viele Grüße"
& vbLf _
&
"Euer Uwe"
.Attachments.Add Pfad & "\" & Filename
.Attachments.Add Pfad & "\" & Filename
.ReadReceiptRequested =
False
.Display
End
With
Filename = Dir
Loop
Set
Mail =
Nothing
End
Sub