Add VBA2

VBA2

@@ -0,0 +1,53 @@
+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