Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objMail As MailItem, strSubj As String
Dim I&, tmp As Variant, blnHasDate As Boolean
On Error Resume Next
If Item.Class = olMail Then
Set objMail = Item
With objMail
If InStr(LCase$(.To), "@hotmail.com") _
<> 0 Then
tmp = Split(.Subject, " ")
For I = 0 To UBound(tmp)
While Right(tmp(I), 1) = "."
tmp(I) = Left(tmp(I), Len(tmp(I)) - 1)
Wend
If IsDate(tmp(I)) Then
blnHasDate = True
Exit For
End If
Next I
If Not blnHasDate Then
For I = 0 To UBound(tmp)
strSubj = strSubj & tmp(I) & " "
Next I
.Subject = strSubj & "[Wichtig]"
.Save
End If
End If
End With
End If
End Sub