1. Sub SendEmails()
2.     Dim OutlookApp As Object
3.     Dim OutlookMail As Object
4.     Dim MailRecipients As Worksheet
5.     Dim LastRow As Long
6.     Dim RecipientEmail As String
7.     Dim SendStatus As String
8.     Dim EmailSubject As String
9.     Dim EmailText As String
10.     Dim OutlookLogo As String
11.    
12.     ' Initialize Outlook
13.     Set OutlookApp = CreateObject("Outlook.Application")
14.    
15.     ' Load the worksheet with recipient data
16.     Set MailRecipients = Workbooks.Open("C:\TEMP\Mail_Empfaenger.xlsx").Sheets(1)
17.     LastRow = MailRecipients.Cells(MailRecipients.Rows.Count, "A").End(xlUp).Row
18.    
19.     ' Loop through each row of data
20.     For i = 2 To LastRow
21.         ' Create a new email for each recipient
22.         Set OutlookMail = OutlookApp.CreateItem(0) ' 0: olMailItem
23.        
24.         RecipientEmail = MailRecipients.Cells(i, 1).Value
25.         SendStatus = MailRecipients.Cells(i, 2).Value
26.         EmailSubject = MailRecipients.Cells(i, 3).Value
27.         EmailText = MailRecipients.Cells(i, 4).Value
28.        
29.         ' Create the email
30.         With OutlookMail
31.             .To = RecipientEmail
32.             .subject = EmailSubject
33.             .htmlBody = EmailText & "<br><br><img src='C:\\TEMP\\Ziel.jpg' height='100' width='150'><br><br>" & " Weitere Text hier eingeben"
34.  
35.             ' Attach the image
36.             .Attachments.Add "C:\TEMP\Ziel.jpg"
37.            
38.             ' Send or display based on the status
39.             Select Case SendStatus
40.                 Case "Send"
41.                     .Send
42.                 Case "Anzeigen"
43.                     .Display
44.                 Case Else
45.                     ' Do nothing
46.             End Select
47.         End With
48.     Next i
49.    
50.     ' Close Outlook objects
51.     Set OutlookMail = Nothing
52.     Set OutlookApp = Nothing
53.    
54.     ' Display the message box with statistics
55.     MsgBox "Emails Sent: " & LastRow - 1 & vbCrLf & "Emails Displayed: 0" & vbCrLf & "Do Nothing: 0", vbInformation
56. End Sub
57.