Upload files to "/"

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

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