Следующий фрагмент хорошо выполняет свою работу, написал ее примерно через 3-4 часа, и писать было довольно тяжело;)
Любые комментарии о том, как сделать код более лаконичным и лучше структурированным, приветствуются.
Я оставил комментарии по частям, которые, как мне показалось, были немного неясны для будущих посетителей. Если вы читаете это и ничего не понимаете, оставьте комментарий! :)
Dim WithEvents curCal As Items ' set var as the holder of Item events Public lastSavedAppointmentStart As Date ' variable so we won't infinitely loop when saving Items Public lastSavedAppointmentEnd As Date Public justSaved As Boolean ' Some initial Startup Code from slipstick.com ' F5 while the cursor is in this sub (in the vba editor) ' will reload the so called "project" Private Sub Application_Startup() Dim NS As Outlook.NameSpace Set NS = Application.GetNamespace("MAPI") Set curCal = NS.GetDefaultFolder(olFolderCalendar).Items Set NS = Nothing lastSavedAppointmentStart = Now() lastSavedAppointmentEnd = Now() End Sub Private Sub checkPrependtime(ByVal Item As Object) Dim isntLastAppt As Boolean isntLastAppt = isntLastSavedAppointment(Item) If justSaved = False And isntLastAppt Then If Not isTimePrepended(Item) Then Call saveLastAppointment(Item) Call prependTime(Item) Else Call removePrependedTime(Item) End If Else justSaved = False End If End Sub Function isntLastSavedAppointment(ByVal Item As Outlook.AppointmentItem) As Boolean isntLastSavedAppointment = lastSavedAppointmentStart <> Item.start Or lastSavedAppointmentEnd <> Item.End End Function Private Sub saveLastAppointment(ByVal Item As Outlook.AppointmentItem) justSaved = True lastSavedAppointmentStart = Item.start lastSavedAppointmentEnd = Item.End End Sub Private Sub removePrependedTime(ByVal Item As Outlook.AppointmentItem) Set lastSavedAppointment = Nothing Dim oldSubject As String ' Cut out the time part of the subject (e.g. 13:00-15:00 Meeting with Joe) ' returns Meeting with Joe oldSubject = Mid(Item.Subject, 13, Len(Item.Subject)) Item.Subject = oldSubject Item.Save End Sub Private Sub prependTime(ByVal appt As Outlook.AppointmentItem) Dim newSubject As String, apptStart As Date, apptEnd As Date Set lastSavedAppointment = appt newSubject = Format(appt.start, "hh:mm") & "-" & Format(appt.End, "hh:mm") & " " & appt.Subject appt.Subject = newSubject appt.Save End Sub ' Check whether the third char is : ' If time is prepended (e.g. Item.subject is something like ' "12:00-13:00 Meeting with joe" Then third char is always :) Function isTimePrepended(ByVal Item As Outlook.AppointmentItem) As Boolean isTimePrepended = InStr(3, Item.Subject, ":") End Function ' BEGIN event handlers Private Sub curCal_ItemAdd(ByVal Item As Object) If TypeOf Item Is Outlook.AppointmentItem Then Call prependTime(Item) End If End Sub Private Sub curCal_ItemChange(ByVal Item As Object) If TypeOf Item Is Outlook.AppointmentItem Then Call checkPrependtime(Item) End If End Sub ' END event handlers