Compare commits

..

No commits in common. "main" and "v1.0.2" have entirely different histories.
main ... v1.0.2

11 changed files with 0 additions and 105 deletions

52
VBA
View file

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

53
VBA2
View file

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

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.