Was icht noch vergessen habe zu erwähnen, alle Aktionen finden in einem eingehängten Kalender statt, also nicht in "meinem". Ich lösche also ein Item in einem eingehängten Kalender und es soll automatisch in einem anderen eingehängten Kalender gelöscht werden. Ich habe den geposteten Code in der beschriebenen Konstellation getestet, leider wird die _BefireItemMove nie aufgerufen.

Option Explicit
 
Private WithEvents m_objCalFolder As Outlook.Folder
Private m_objDelFolder As Outlook.Folder
 
Private Sub Application_Quit()
  Set m_objCalFolder = Nothing
  Set m_objDelFolder = Nothing
End Sub
 
Private Sub Application_Startup()
  With ThisOutlookSession.GetNamespace("MAPI")
    Set m_objCalFolder = GetFolder("\\username\Kalender")
    Set m_objDelFolder = .GetDefaultFolder(olFolderDeletedItems)
  End With
End Sub
 
Private Sub m_objCalFolder_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, Cancel As Boolean)
 MsgBox ("delellelelel")

  Dim bolDel As Boolean
   
  If TypeOf Item Is Outlook.appointmentItem Then
   
    If MoveTo Is Nothing Then
      bolDel = True
    ElseIf MoveTo = m_objDelFolder Then
      bolDel = True
    End If
   
  End If
   
  If bolDel Then
     
    MsgBox Item.Subject
     
  End If
   
End Sub

Function GetFolder(ByVal FolderPath As String) As Outlook.Folder
  Dim TestFolder As Outlook.Folder
  Dim FoldersArray As Variant
  Dim i As Integer
 
   On Error GoTo GetFolder_Error
   If Left(FolderPath, 2) = "\\" Then
     FolderPath = Right(FolderPath, Len(FolderPath) - 2)
   End If
   'Convert folderpath to array
   FoldersArray = Split(FolderPath, "\")
   Set TestFolder = Application.Session.Folders.Item(FoldersArray(0))
   If Not TestFolder Is Nothing Then
     For i = 1 To UBound(FoldersArray, 1)
       Dim SubFolders As Outlook.Folders
       Set SubFolders = TestFolder.Folders
       Set TestFolder = SubFolders.Item(FoldersArray(i))
      If TestFolder Is Nothing Then
        Set GetFolder = Nothing
      End If
     Next
   End If
   'Return the TestFolder
   Set GetFolder = TestFolder
 Exit Function
 
GetFolder_Error:
 Set GetFolder = Nothing
 Exit Function
End Function