Email wenn Datum überschritten

Sub ReminderEmailForSpecificColumns()

  Dim rCell As Range

  Dim objApp As Object

  Dim objMailtm As Object

  Dim columnsToCheck As Variant

  Dim tReceiver As String

  Dim subjectLine As String

  Dim emailBody As String

  Dim ws As Worksheet

  Dim tDays As Long

  

  Set ws = Sheets("Sommer1")

  columnsToCheck = Array("C", "D", "E", "F")

  tReceiver = "example@gmail.com"

  tDays = 60

  

  Set objApp = CreateObject("Outlook.Application")

  

  Dim col As Variant

  For Each col In columnsToCheck

    For Each rCell In ws.Range(col & "2:" & col & "200")

      If IsDate(rCell.Value) Then

        If rCell.Value - Date = tDays Then

          Set objMailtm = objApp.CreateItem(0)

          subjectLine = "Erinnerung: Fälligkeit in 60 Tagen"

          emailBody = "Hallo," & vbCrLf & vbCrLf & _

                      "Das Datum " & rCell.Value & " in Zelle " & rCell.Address & _

                      " wird in 60 Tagen erreicht." & vbCrLf & _

                      "Bitte beachten Sie die Aufgabe in Ihrer Tabelle." & vbCrLf & vbCrLf & _

                      "Mit freundlichen Grüßen," & vbCrLf & "Ihr Excel VBA-Skript"

                      

         With objMailtm

           .To = tReceiver

           .Subject = subjectLine

           .Body = emailBody

           End With

           

           rCell.Offset(0, 1).Value = "E-Mail gesendet am " & Date

           Set objMailtm = Nothing

          End If

         End If

        Next rCell

       Next col

      Set objApp = Nothing

      

      MsgBox "Das Makro wurde abgeschlossen.", vbInformation

     End Sub