|
Hallo,
schau mal, so ungefähr könnte das Grundgerüst aussehen:
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) ' TO: Recipient 1
objMailItem.CC = .Cells(i, 4) ' CC: Recipient 2
objMailItem.Display
Set objMailItem = Nothing
Next
End With
' Cleanup
Set objOLApp = Nothing
wkb.Close SaveChanges:=False: Set wkb = Nothing
End Sub
In diesem Beispiel wird der 2. Empfänger einfach unter "CC" aufgeführt. Die Konstanten usw. mußt du natürlich noch an deine Gegebenheiten anpassen.
Noch zwei Hinweise:
1. Hinter Else kommt kein ":"
2. Wenn du eine Mail-Adresse validieren möchtest, solltest du den Code nicht zweimal schreiben, sondern eine Funktion dafür erstellen.
|