Add VBA

VBA

@@ -0,0 +1,52 @@
+Sub SletAltiplanBegivenheder()
+    Dim nms As NameSpace
+    Dim fld As Folder
+    Dim itm As Object
+    Dim i As Long
+    Dim kategoriNavn As String
+    Dim sletAntal As Long
+    Dim svar As VbMsgBoxResult
+    
+    ' Definition af kategorien
+    kategoriNavn = "Fra Altiplan"
+    sletAntal = 0
+    
+    ' Sikkerhedsspørgsmål før vi går i gang
+    svar = MsgBox("Vil du slette alle kalenderbegivenheder med kategorien '" & kategoriNavn & "'?", _
+                  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 (vigtigt ved sletning)
+    For i = fld.Items.Count To 1 Step -1
+        Set itm = fld.Items(i)
+        
+        ' Tjek om elementet er en kalenderaftale
+        If itm.Class = olAppointment Then
+            ' Tjek om kategorien matcher (uafhængig af store/små bogstaver)
+            If InStr(1, itm.Categories, kategoriNavn, vbTextCompare) > 0 Then
+                itm.Delete
+                sletAntal = sletAntal + 1
+            End If
+        End If
+    Next i
+    
+    ' Statusbesked til brugeren
+    MsgBox "Færdig! Der blev slettet " & sletAntal & " begivenheder med kategorien '" & kategoriNavn & "'.", _
+           vbInformation, "Status"
+
+    ' Åbn import-vinduet
+    On Error Resume Next
+    Application.ActiveExplorer.CommandBars.ExecuteMso "ImportExport"
+    
+    ' Hvis ovenstående fejler (fejl 438), så giv besked i stedet for at gå ned
+    If Err.Number <> 0 Then
+        MsgBox "Sletning gennemført, men import-vinduet kunne ikke åbnes automatisk." & vbCrLf & _
+               "Gå til Filer -> Åbn og eksportér -> Importér for at vælge din nye fil.", vbExclamation
+    End If
+    On Error GoTo 0
+    
+End Sub