53 lines
No EOL
1.7 KiB
Text
53 lines
No EOL
1.7 KiB
Text
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 |