VBATools

Czy zdarzyło się wam aby Outlook zapętlił przypomnienia? Kasowanie każdego z wydarzeń, które miały by informować użytkownika przypomnienie, nie daje pożądanego rezultatu?

Taki przypadek omawiany był na naszym Outlookowym Forum.

Poniższy kod ściąga flagi łączące przypomnienie z wydarzeniem i sprawdza czy ustawienie “dzwoneczka” powinno się już zakończyć (data monitu jest mniejsza niż obecna). Celem jego działania jest ich eliminacja, tak aby użytkownik nie był więcej nimi nękany.

Makro należy uruchomić z pozycji otwartego folderu kalendarza, gdzie zapisane są wydarzenia. Parametr ten można zmienić na domyślny folder wydarzeń, jednakże w tej postaci jest bardziej uniwersalny.

Sub wlaczanie_przypomninia()
 Dim msg$, Response$, q&
 msg = "Procedura włączenia przypomnień do terminów w wiadomościach Outlooka" & vbCr & vbCr _
 & "Aby kontynuować naciśnij ''Tak''" & vbCr _
 & "Aby anulować operacje naciśnij ''Nie''"

 On Error GoTo blad
 Response = MsgBox(msg, vbYesNo + vbExclamation + vbDefaultButton2, " Aktualizacja przypomnień - VBATools.pl")
 If Response = vbYes Then
 Dim OutApp As Object
 Set OutApp = CreateObject("Outlook.Application")
 OutApp.Session.Logon

 Dim oApptFolder As MAPIFolder
 Set oApptFolder = OutApp.Application.ActiveExplorer.CurrentFolder
 Dim oMail As MailItem
 Dim olApp As Items
 Set olApp = oApptFolder.Items
 For q = 1 To olApp.Count
  DoEvents
  On Error Resume Next
  Set oMail = olApp.item(q)
  If oMail.Start < Now Then
   oMail.ReminderSet = False
   oMail.ClearTaskFlag
   oMail.Save
  End If
 Next q
 MsgBox "Wyłączone stare przypomnienia !", vbInformation, "O'Shon machine from VBATools."
 Set oMail = Nothing
 Set OutApp = Nothing
 Set oApptFolder = Nothing
 End If
 Exit Sub
 blad:
 MsgBox "Błąd: " & Err.Number & vbCr & Err.Description, vbExclamation
 End Sub

(c) Shon Oskar – www.VBATools.pl