Version 2

Option Explicit

Dim oCLMailActionEvent
On Error Resume Next
    Set oCLMailActionEvent = GetObject("Cosmolink.CLMailActionEvent")

    If Err.Number <> 0 Then
        cRM.DialogMessageBox "Der Vorgang wird beendet." & vbCrLf & "Es ist ein unerwartetes Verhalten beim Laden des 'Cosmolink.CLMailActionEvent' aufgetreten." & vbCrLf & vbCrLf & "Ursprung: " & Err.Source & vbCrLf & "Code: " & Err.Number & vbCrLf & "Beschreibung: " & Err.Description, "(c) " & Year(Date) & " cosmolink", vbExclamation
        Err.Clear
        Beenden()
    End If
On Error GoTo 0

Dim oCurrentMailItem
Set oCurrentMailItem = oCLMailActionEvent.CurrentMailItem

if oCurrentMailItem is Nothing Then 
    cRM.DialogMessageBox "Der Vorgang wird beendet." & vbCrLf & "Die synchronisierende E-Mail konnte nicht ermittelt werden", "E-Mail Daten konnten nicht ermittelt werden", vbExclamation
    Beenden()
End If 

Dim oBlacklistEntry, oSender

Set oSender = oCurrentMailItem.Sender

if oSender is Nothing Then 
    cRM.DialogMessageBox "Der Vorgang wird beendet." & vbCrLf & "Der Absender konnte nicht ermittelt werden", "E-Mail Daten konnten nicht ermittelt werden", vbExclamation
    Beenden()
End If 

'Präfen ob eine E-Mail Adresse auf der Blacklist steht
Set oBlacklistEntry = oCLMailActionEvent.ProjectConfiguration.GetBlacklistElement(oSender.Address)

Dim bIsBlacklisted
if oBlacklistEntry is Nothing Then 
    bIsBlacklisted = false
Else
    bIsBlacklisted = oBlacklistEntry.IsMail OR oBlacklistEntry.IsDomain
End If 

Dim sDetails

sDetails = "Absender: " & oSender.Address & vbCrLf & _
"Absender Blacklisted: " & bIsBlacklisted & vbCrLf & _
"Betreff: " & oCurrentMailItem.Subject & vbCrLf & _
"Versendet: " & oCurrentMailItem.SentAt & vbCrLf & _
"Empfangen: " & oCurrentMailItem.ReceivedAt & vbCrLf & _
"Priorität: " & oCurrentMailItem.PriorityName & vbCrLf & _
"Richtung: " & oCurrentMailItem.DirectionName & vbCrLf & _
"Anhänge: " & oCurrentMailItem.Attachments.Count

Dim nResult
nResult = cRM.DialogChoiceMessageBox("Mächten Sie die nachfolgende E-Mail als Aktivität speichern?" & vbCrLf & vbCrLf & sDetails, "Aktivität anlegen", "Keine Aktivität erfassen" & vbTab & "Aktivität mit Firma verknäpfen" & vbTab & "Aktivität mit Kontakt verknäpfen", vbQuestion, false)

if nResult = 101 Then
    oCLMailActionEvent.Result.Successful = true
    oCLMailActionEvent.Result.AdditionalExecutionAllowed = true
    Beenden()
End If 

Dim sDialogSelectRecordTitle, sViewName, sContactRecordId, sCompanyRecordId

sContactRecordId = ""
sCompanyRecordId = ""

Select Case nResult
    Case 102
        sDialogSelectRecordTitle = "Bitte wählen Sie die Firma aus"
        sViewName = "Firmen"
    Case 103
        sDialogSelectRecordTitle = "Bitte wählen Sie den Kontakt aus"
        sViewName = "Kontakte"
End Select

Dim oProject, oListViewConfigs, oViewConfig, oViewRecordSet, oViewRecord

Set oProject = cRM.CurrentProject
Set oListViewConfigs = oProject.ViewConfigs
Set oViewConfig = oListViewConfigs.ItemByName(sViewName)

If oViewConfig is Nothing Then
    cRM.DialogMessageBox "Der Vorgang wird beendet." & vbCrLf & "Es konnte nicht auf die Ansicht '"&sViewName&"' zugegriffen werden.", "Zugriff auf Ansicht fehlgeschlagen", vbExclamation
    Beenden()
End If

Set oViewRecordSet = oViewConfig.CreateRecordSet()

If oViewRecordSet is Nothing Then
    cRM.DialogMessageBox "Der Vorgang wird beendet." & vbCrLf & "Beim Zugriff auf das RecordSet ist ein unerwartetes Verhalten aufgetreten.", "Unerwartetes Verhalten festgestellt", vbExclamation
    Beenden()
End If

If NOT oViewRecordSet.MoveFirst Then
    cRM.DialogMessageBox "Der Vorgang wird beendet." & vbCrLf & "Der Filter hat keine Daten im RecordSet zuräckgeliefert.", "Keine Datensätze gefunden", vbExclamation
    Beenden()
End If

Set oViewRecord = oViewRecordSet.DialogSelectRecord(sDialogSelectRecordTitle, true)

If oViewRecord is Nothing Then
    'Benutzer hat die Abbrechen Schaltfläche betätigt
    Beenden()
End If

Select Case nResult
    Case 102
        sCompanyRecordId = oViewRecord.GetContentsByName("ID")
    Case 103
        sContactRecordId = oViewRecord.GetContentsByName("ID")
End Select

Dim oActivity

'CreateActivityCurrentMail(string companyRecordid, string contactRecordid) -> Nutzt das CurrentMailItem (nur in VBS verfägbar)
Set oActivity = oCLMailActionEvent.CreateActivityCurrentMail(sCompanyRecordId, sContactRecordId)

'Zeigt cRM an
oCLMailActionEvent.CombitCrmHelper.ShowMainWindow()

'Zeit die angegebene Aktivität
oCLMailActionEvent.CombitCrmHelper.OpenViewInCrmByActivity(oActivity)

'Markieren der Aktion als erfolgreich -> wichtig!!!!
oCLMailActionEvent.Result.Successful = true

'Erlaubt eine erneute Ausfährung des Skriptes. Default: false
'Sollte nur in Fällen genutzt werden, wo das explizit notwendig ist. Z.b. Filtern von allen Aktivitäten des absenders
oCLMailActionEvent.Result.AdditionalExecutionAllowed = true

Sub Beenden()

    Set oViewRecord = Nothing
    Set oViewRecordSet = Nothing
    Set oViewConfig = Nothing
    Set oListViewConfigs = Nothing
    Set oProject = Nothing
    Set oSender = Nothing
    Set oBlacklistEntry = Nothing
    Set oCurrentMailItem = Nothing
    Set oCLMailActionEvent = Nothing

    WScript.Quit
End Sub