VBA Tools

Outlook posiada możliwość zdefiniowania wydarzenia całodziennego. Jego aktywacja domyślnie zaznacza przypomnienie na 18 godzin przed godziną 00:00.

Jeżeli użytkownik MS Outlook ogranicza się jedynie do aplikacji nie widzi w dym żadnego problemu. W momencie synchronizacji Outlooka z PDA, telefonem komórkowym lub innym urządzeniem, które ma wbudowany kalendarz otrzymujemy komunikat przypominający w nocy. Jak się zabezpieczyć, wyłączyć lub ustalić odpowiednią godzinę przypomnienia inaczej niż edycja pola przypomnienia w momencie edycji wydarzenia?

Rys1. Możliwość ustawienia czasu przypomnienia podczas edycji wydarzenia.

Przytoczę tutaj procedurę kolegi Ruut’a (wyłączenie przypomnień) oraz moją modyfikacje kodu polegającą na przestawieniu wydarzenia całodziennego na czasowe z ustaleniem godziny początku zdarzenia jako start przypomnienia.

Sub Check_all_calender_items_and_disable_reminder_if_set_to_18_hours()
'Ruut Brandsma on 12/04/2007
 Set myNamespace = Application.GetNamespace("MAPI")
 Set Application.ActiveExplorer.CurrentFolder = myNamespace.
GetDefaultFolder(olFolderCalendar)
 For Each item In Application.ActiveExplorer.CurrentFolder.Items
 With item
 If .Class = olAppointment Then
 If .ReminderMinutesBeforeStart = 18 * 60 And .ReminderSet
Then
 .ReminderSet = False
 .Save
 End If
 End If
 End With
 Next
 Set Application.ActiveExplorer.CurrentFolder = myNamespace.
GetDefaultFolder(olFolderInbox)
End Sub

Sub Check_all_calender_items_and_change_18_hours()
'MVP OShon from VBATools.pl
Dim item As Object
With Application.GetNamespace("MAPI")
 Set Application.ActiveExplorer.CurrentFolder = .GetDefaultFolder(olFolderCalendar)
 For Each item In Application.ActiveExplorer.CurrentFolder.Items
 DoEvents
 With item
 If .Class = olAppointment Then
 If .ReminderMinutesBeforeStart = 18 * 60 Then
 .Start = Format(.Start, "YYYY-MM-DD") & " 9:00" 'opcjonalne
 .End = Format(.Start, "YYYY-MM-DD") & " 23:59"  'opcjonalne
 .ReminderMinutesBeforeStart = 0 'możliwość ustawienia innego czasu przypomnienia h * 60
 .ReminderSet = True
 .Save
 End If
 End If
 End With
 Next
 Set Application.ActiveExplorer.CurrentFolder = .GetDefaultFolder(olFolderInbox)
End With
End Sub