Automatisch een email versturen aan een specifieke persoon als een bepaalde datum is bereikt

[Ton0401]

Ik heb een VBA om het volgende te doen:
- in de cellen C2:C100 staat een datumnotatie
- In de cellen D2100 staat de verantwoordelijke persoon (initialen)
- In de cellen C2:C100 het emailadres van deze specifieke persoon

Wat ik heb proberen te bereiken is dat op de datum in bijvoorbeeld Cel C2 een email wordt gestuurd naar de persoon, waarvan de initialen staan in cel D2 naar het emailadres in cel E2

Dit heb ik, maar het werkt niet... maar ik hoop dat iemand mij verder kan helpen:

Sub StuurEmailAlsDatumBereikt()
Dim ws As Worksheet
Dim cel As Range
Dim outlookApp As Object
Dim mailItem As Object
Dim emailAdres As String
Dim initialen As String
Dim huidigeDatum As Date


Set ws = ThisWorkbook.Sheets("Blad1")


huidigeDatum = Date


For Each cel In ws.Range("C2:C100")
If cel.Value = huidigeDatum Then

emailAdres = cel.Offset(0, 1)

If emailAdres <> "" Then

Set outlookApp = CreateObject("Outlook.Application")
Set mailItem = outlookApp.CreateItem(0)

.To = emailAdres
.Subject = "Herinnering: Deadline bereikt!"
.Body = "Beste, " & vbNewLine & vbNewLine & _
"De datum " & cel.Value & " is bereikt. " & vbNewLine & _
"Neem indien nodig actie." & vbNewLine & vbNewLine & _
"Met vriendelijke groet,"
.Send
End With

Set mailItem = Nothing
Set outlookApp = Nothing
End If
End If
Next cel
End Sub


End Sub

 

[Warme bakkertje]

Probeer eens met deze.

Sub StuurEmailAlsDatumBereikt()
    Dim cl As Range
    For Each cl In Sheets("Blad1").Range("C2:C100")
        If cl.Value = Date Then
            If cl.Offset(, 2) <> vbNullString Then
                With CreateObject("Outlook.Application").CreateItem(0)
                    .To = cl.Offset(, 2).Value
                    .Subject = "Herinnering: Deadline bereikt!"
                    .Body = "Beste, " & vbNewLine & vbNewLine & _
                        "De datum " & cl.Value & " is bereikt. " & vbNewLine & _
                        "Neem indien nodig actie." & vbNewLine & vbNewLine & _
                        "Met vriendelijke groet,"
                    .Send
                End With
            End If
        End If
    Next
End Sub