Sub CreateMails()
Dim objOLApp As Object
Dim objMailItem As Object
Dim wkb As Workbook
Dim lastRow As Long
Dim i As Long
Const MAIL_LIST As String = "MailListe.xlsx"
Const MAIL_TEMPLATE As String = "MyTemplate.oft"
Const COL_USER_NAME As Long = 1
Const COL_RECPIENT_1 As Long = 3
Const COL_RECPIENT_2 As Long = 4
Set objOLApp = CreateObject("Outlook.Application")
Set wkb = Workbooks.Open(MAIL_LIST, , True)
With wkb.Sheets(1)
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
Set objMailItem = objOLApp.CreateItemFromTemplate(MAIL_TEMPLATE)
objMailItem.Subject = "User " & .Cells(i, 1) _
& " vom " _
& FormatDateTime(Date, "YYYYMMDD")
objMailItem.To = .Cells(i, 3)
objMailItem.CC = .Cells(i, 4)
objMailItem.Display
Set objMailItem = Nothing
Next
End With
Set objOLApp = Nothing
wkb.Close SaveChanges:=False: Set wkb = Nothing
End Sub