Private Sub Application_Reminder(ByVal Item As Object)

If Item.Subject = "Process Calls" Then

' Define variables
Dim objCalendar As Outlook.Folder
Dim objItems As Outlook.Items
Dim objAppt As Outlook.AppointmentItem
Dim strRestriction As String
Dim objFinalItems As Outlook.Items
Dim myolApp As Outlook.Application

' Set strRestriction to be only recent calls
strRestriction = "@SQL= (""urn:schemas:httpmail:subject"" LIKE '@Call%' OR ""urn:schemas:httpmail:subject"" LIKE 'C%' AND %last7days(""urn:schemas:calendar:dtstart"")%)"

Dim iItemsUpdated As Integer
Dim strTemp As String

' Set the objCalendar and objItems items
Set objCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
Set objItems = objCalendar.Items
Set objFinalItems = objItems.Restrict(strRestriction)
Set myolApp = CreateObject("Outlook.Application")
iItemsUpdated = 0

For Each objAppt In objFinalItems

If InStr(1, Item.Categories) <> "Call" Then

If Left(LCase(objAppt.Location), 11) = "missed call" Then
objAppt.Categories = "S. CALL MISSED."

ElseIf objAppt.Location = "Incoming Call" Then
objAppt.Categories = "S. CALL RECEIVED."

Else

objAppt.Categories = "S. CALL MADE."

End If

'strTemp = Right(objAppt.Subject, (Len(objAppt.Subject) - 5))
'objAppt.Subject = strTemp
'MsgBox strTemp
'iItemsUpdated = iItemsUpdated + 1

objAppt.Save
End If
Next

' Rename Entry

'MsgBox iItemsUpdated & " of " & objCalendar.Items.Count & " Meetings Updated"

End If


End Sub