Private Sub Application_Reminder(ByVal Item As Object)
    Dim apti As AppointmentItem
    Dim subj As String
    'в Outlook вручную должна быть создана встреча с темой subj (см.ниже)
    'если напоминалка взлетела не от встречи - сразу выходим, другие нам не интересны
    If TypeName(Item) <> "AppointmentItem" Then Exit Sub
    Set apti = Item
    subj = "timmer"
    'проверяем, что встреча - наша
    If apti.Subject = subj Then
        'удаление напоминалки
        apti.Application.Reminders.Remove subj
        'далее - собственно код,выполняющий задачу
        'Call что-то полезное
        '"заводим" ту же встречу на следующий раз, к примеру, через 5 минут
        With apti
            .Start = DateAdd("n", 5, Now)
            .End = DateAdd("n", 1, .Start)
            .ReminderSet = True
            .ReminderMinutesBeforeStart = 0
            .Save
        End With
    End If
    Set apti = Nothing
End Sub

Function Getcbr(ByVal dt As Date, sCBRFCurCode As String)
    Dim sURL As String, Doc As Object
    sURL = "http://www.cbr.ru/scripts/XML_dynamic.asp?date_req1=" & Format(dt, "dd\/mm\/yyyy") & _
           "&date_req2=" & Format(dt, "dd\/mm\/yyyy") & _
           "&VAL_NM_RQ=" & sCBRFCurCode
    On Error Resume Next
    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    With oXMLHTTP
        .Open "GET", sURL, False
        .send
        Set Doc = .responsexml
        Set x = Doc.SelectSingleNode("//Value")
        If Not x Is Nothing Then
            Getcbr = x.Text
        End If
    End With
    Set oXMLHTTP = Nothing
End Function