Compare commits
No commits in common. "main" and "v1.0.3.5" have entirely different histories.
7 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.
Binary file not shown.
Binary file not shown.
Loading…
Reference in a new issue