Sub SletAltiplanOgFriBegivenheder()
    Dim nms As NameSpace
    Dim fld As Folder
    Dim itm As Object
    Dim i As Long
    Dim kategori1 As String
    Dim kategori2 As String
    Dim sletAntal As Long
    Dim svar As VbMsgBoxResult
    
    ' Definition af kategorierne
    kategori1 = "Fra Altiplan"
    kategori2 = "Fri"
    sletAntal = 0
    
    ' Sikkerhedsspørgsmål
    svar = MsgBox("Vil du slette alle kalenderbegivenheder med kategorierne '" & kategori1 & "' og '" & kategori2 & "'?", _
                  vbQuestion + vbYesNo, "Bekræft sletning")
    
    If svar = vbNo Then Exit Sub
    
    Set nms = Application.GetNamespace("MAPI")
    Set fld = nms.GetDefaultFolder(olFolderCalendar)
    
    ' Vi løber kalenderen igennem bagfra
    For i = fld.Items.Count To 1 Step -1
        Set itm = fld.Items(i)
        
        If itm.Class = olAppointment Then
            ' Tjek om enten kategori 1 ELLER kategori 2 findes i begivenheden
            If InStr(1, itm.Categories, kategori1, vbTextCompare) > 0 Or _
               InStr(1, itm.Categories, kategori2, vbTextCompare) > 0 Then
                
                itm.Delete
                sletAntal = sletAntal + 1
            End If
        End If
    Next i
    
    ' Statusbesked
    MsgBox "Færdig! Der blev slettet " & sletAntal & " begivenheder i alt.", _
           vbInformation, "Status"

    ' Åbn import-vinduet med fejlhåndtering (som før)
    On Error Resume Next
    Application.ActiveExplorer.CommandBars.ExecuteMso "ImportExport"
    
    If Err.Number <> 0 Then
        MsgBox "Sletning gennemført, men import-vinduet skal åbnes manuelt via Filer -> Åbn og eksportér.", vbExclamation
    End If
    On Error GoTo 0
    
End Sub