Compare commits
No commits in common. "main" and "v1.1.0" have entirely different histories.
5 changed files with 0 additions and 105 deletions
52
VBA
52
VBA
|
|
@ -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
53
VBA2
|
|
@ -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.
Loading…
Reference in a new issue