AW: Datum überschritten E-Mail senden
13.06.2017 08:41:57
UweD
Hallo
Da du keine Musterdatei angehangen hast === ungetestet....
Private Sub Workbook_Open()
Dim rCell As Range
Dim objApp As Object
Dim objMailItm As Object
Dim tBRng As String
Dim tReceiver As String
tBRng = "A11:A" & Sheets("ToDo").UsedRange.Rows.Count
Set objApp = CreateObject("Outlook.Application")
For Each rCell In Sheets("ToDo").Range(tBRng)
If IsDate(rCell.Offset(0, 5).Value) Then
If rCell.Offset(0, 5) - Date <= Sheets("ToDo").Range("A3").Value _
And Not (rCell.Offset(0, 9).Value) Then
Set objMailItm = objApp.CreateItem(0)
With objMailItm
.BCC = rCell.Offset(0, 1)
.Subject = "Fälligkeitswarnung"
.Body = "Die Tätigkeit <" & _
rCell.Offset(0, 1).Value & ">" & vbCrLf & _
"wird am " & rCell.Offset(0, 5).Value & " fällig!"
.Send
End With
rCell.Offset(0, 9).Value = True
Set objMailItm = Nothing
End If
End If
Next
Set objApp = Nothing
End Sub
LG UweD