Private Sub Application_ItemLoad(ByVal item As Object)
Dim objMail As Object, objMailItem As MailItem
Dim strSMTPAdresse As String, strKategorie As String
strSMTPAdresse = Session.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress
If Application.ActiveExplorer.Selection.Count = 1 And InStr(Application.ActiveExplorer.Caption, "planung@xxxxx.de") > 0 Then
For Each objMail In Application.ActiveExplorer.Selection
If (TypeOf item Is MailItem) Then
Set objMailItem = objMail
Debug.Print objMailItem.Categories
strKategorie = CStr(objMailItem.Categories)
Select Case strSMTPAdresse
Case "usera@xxxxx.de"
If InStr(strKategorie, "Gelesen von User A") = 0 Then
objMailItem.Categories = objMailItem.Categories & ",Gelesen von User A"
objMailItem.Save
End If
Case "userb@xxxxx.de"
If InStr(strKategorie, "Gelesen von User B") = 0 Then
objMailItem.Categories = objMailItem.Categories & ",Gelesen von User B"
objMailItem.Save
End If
Case "userc@xxxxx.de"
If InStr(strKategorie, "Gelesen von User C") = 0 Then
objMailItem.Categories = objMailItem.Categories & ",Gelesen von User C"
objMailItem.Save
End If
Case "userd@xxxxx.de"
If InStr(strKategorie, "Gelesen von Uder D") = 0 Then
objMailItem.Categories = objMailItem.Categories & ",Gelesen von User D"
objMailItem.Save
End If
Case "usere@xxxxx.de"
If InStr(strKategorie, "Gelesen von User E") = 0 Then
objMailItem.Categories = objMailItem.Categories & ",Gelesen von User E"
objMailItem.Save
End If
Case Else
Exit Sub
End Select
End If
If InStr(strKategorie, "Gelesen von User A") And InStr(strKategorie, "Gelesen von User B") And InStr(strKategorie, "Gelesen von User C") And InStr(strKategorie, "Gelesen von User D") And InStr(strKategorie, "Gelesen von User E") Then
objMailItem.UnRead = False
objMailItem.Save
Else
objMailItem.UnRead = True
objMailItem.Save
End If
Next objMail
End If
End Sub