Cells(Target.Row, 10).Value = aIt.EntryID

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As _
  Boolean)
 
    If IsEmpty(Cells(Target.Row, 10).Value) Then
        Set aIt = OA.CreateItem(1) ' olAppointmentItem
    Else
        Dim NS As Outlook.NameSpace
        Set NS = OA.GetNamespace("MAPI") 'Outlook.GetNamespace("MAPI")
        Set aIt = NS.GetItemFromID(Cells(Target.Row, 10).Text)
    End If

For Each OLIT In OLRS
         ... ' was immer Du mit den gefundenen Einträgen machen willst 
Next OLIT

Dim i as Integer
Dim Bsoc As Boolean ' Stop on conflict
 
Bsoc=true
For i = 1 To OLRS.Count
    If OLRS.Item(i).IsConflict And Bsoc Then
        If MsgBox("A conflict has been detected." & vbCrLf & "Shall I stop ?", _
          vbQuestion + vbYesNo, Capp) = vbYes Then
            Stop ' Wenn jemand das liest und an dieser Stelle 'ne Lösung hätte _
            würde ich mich über 'ne Mail freuen!
        Else
            Bsoc = False
        End If
    Else
        Set OLIT = OLRS.Item(i)
         ... ' was immer Du mit den gefundenen Einträgen machen willst 
        End If
        Set OLIT = Nothing
    End If
Next i