Sub
Versand()
Dim
HJ
As
Integer
, jahr
As
Integer
, n
As
Integer
, i
As
Integer
Dim
Betreff
As
String
, T1
As
String
, t2
As
String
, t3
As
String
, t4
As
String
, t5
As
String
, t6
As
String
Dim
WB
As
Workbook
Dim
S_g
As
Worksheet, S_p
As
Worksheet
Dim
objOutlook
As
Object
Dim
objMail
As
Object
Set
WB = ThisWorkbook
Set
S_g = WB.Sheets(
"Gesamt"
)
Set
S_p = WB.Sheets(
"Mail-Parameter"
)
HJ = S_p.Cells(1, 2).Value
jahr = S_p.Cells(2, 2).Value
Betreff = S_p.Cells(3, 2).Value
T1 = S_p.Cells(4, 2).Value
t2 = S_p.Cells(5, 2).Value
t3 = S_p.Cells(6, 2).Value
t4 = S_p.Cells(7, 2).Value
t5 = S_p.Cells(8, 2).Value
t6 = S_p.Cells(9, 2).Value
n = S_p.Cells(13, 2).Value
For
i = 1
To
n
Name = S_g.Cells(i + 1, 1).Value
Email1 = S_g.Cells(i + 1, 2).Value
Email2 = S_g.Cells(i + 1, 3).Value
Set
objOutlook = CreateObject(
"Outlook.Application"
)
Set
objMail = objOutlook.CreateItem(0)
With
objMail
.
To
= Email1 &
";"
& Email2
.Subject = Betreff
.Body = T1 & Chr(10) & Chr(10) & t2 & Chr(10) & Chr(10) & t3 & Chr(10) & Chr(10) & t4 & Chr(10) & Chr(10) & t5 & Chr(10) & Chr(10) & t6
.Attachments.Add
"B:\2. Produkte & Sparten\2.7. Unternehmensberatung\3.5.16.24 Halbjahresbericht\erstellte Halbjahresberichte\" & jahr & "
\HJ
" & HJ & "
\
" & Name & "
.pdf"
.Display
End
With
Next
i
End
Sub