Outlook 2010 Macro - Repeat Appointments And Change Category

I was getting annoyed with the inability of Outlook to make a recurring monthly bill that I could change the color of individual bills to mark as paid. I spent a little time and came up with a macro to do it. The first macro lets you make one year of appointments that occur on the same day each month. A second button lets you select an appointment (bill) and make it change its category. It is simple but a few others had the same question elsewhere. Enjoy.

Public Sub Create_OutlookRepeatingAppt()

Dim appt As Outlook.AppointmentItem
Dim sName As String
Dim sDay As String
Dim lYear As Long
Dim l As Long
Dim lMonth As Long
sName = InputBox("Input Name", "Input")
sDay = InputBox("Day of month", "Day of month")
lMonth = Month(Date)
lYear = Year(Date)

For l = 0 To 11

Set appt = Outlook.CreateItem(olAppointmentItem)
appt.Location = ""
appt.Subject = sName
appt.Body = ""
appt.Start = CDate(lMonth & "/" & sDay & "/" & lYear & " 12:00")
appt.End = CDate(lMonth & "/" & sDay & "/" & lYear & " 12:00")
'Appt.Label = "Personal"
appt.Categories = "PENDING" 'Create your own category for this
'Bump values if at end of year
Select Case lMonth
Case 12
lYear = lYear + 1
lMonth = 0
End Select
lMonth = lMonth + 1
Next l
Set appt = Nothing

End Sub

Public Sub Appointment_SetToPaid()
Dim appt
Set appt = Application.ActiveExplorer.Selection.Item(1)
appt.Categories = "PAID" 'Create your own category for this
Set appt = Nothing
End Sub

No comments: