Sub mail_reminder()
Dim blatt1 As Object
Dim blatt2 As Object
Dim anzahlzeilen As Long
Dim zeile As Long
Dim spalte As Long
Dim adresszeile
Dim nachricht As String
Set blatt1 = Worksheets(1)
Set blatt2 = Worksheets(2)
nachricht = "Sehr bla bla bla bla "
anzahlzeilen = blatt1.Cells(blatt1.Rows.Count, 5).End(xlUp).Row
For zeile = 2 To anzahlzeilen
For spalte = 12 To 13
If blatt1.Cells(zeile, spalte) <> "" And blatt1.Cells(zeile, spalte + 3) = "" Then
If blatt1.Cells(zeile, spalte) < Date Then
If blatt1.Cells(zeile, 5) <> "" Then
Set adresszeile = blatt2.Columns(2).Find(blatt1.Cells(zeile, 5), LookIn:=xlValues)
If Not adresszeile Is Nothing Then
adresszeile = adresszeile.Row
If blatt2.Cells(adresszeile, 13) <> "" Then
Call mail_erstellen(nachricht, blatt2.Cells(adresszeile, 13), spalte - 11 & ". Erinnerung")
blatt1.Cells(zeile, spalte + 3) = Date
Else
MsgBox "Eine Nachricht kann nicht verschickt werden, da keine EMailadresse gefunden wurde!", , "fehlende Adresse"
End If
End If
End If
End If
End If
Next spalte
Next zeile
Set blatt1 = Nothing
Set blatt2 = Nothing
End Sub
Sub mail_erstellen(text As String, adresse As String, betreff As String)
Dim OLAnwendung As Object
Dim EMail As Object
Set OLAnwendung = CreateObject("Outlook.Application")
Set EMail = OLAnwendung.CreateItem(0)
With EMail
.To = adresse
.Subject = betreff
.body = text
.Display
End With
Set OLAnwendung = Nothing
Set EMail = Nothing
End Sub