Outlook 2016 Update Appointment category when changed in Excel

Kevin8675309

New Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server
I have a task tracking list in an Excel table. I have a macro (attached to a userform CommandButton) that, after I fill out the form, it adds the data to the last row of the table and then creates meeting invites based on the due date and time on each row. To avoid duplication of appointments, the code also adds "Created" in the 18th column, then only creates new appointments if that cell is empty.

This is working relatively well, but I'd like my appointment category to update based on the value in one of the columns (PENDING when created, and changed to CLOSED when it's completed).

Here is the code that creates the appointment invite. How do I construct VBA code to look at the Excel table again to change the category of appointments from PENDING to CLOSED if I have changed it to CLOSED in the table?


Sub Testing ()

Dim olApp As Outlook.Application
Dim OutMail As Outlook.AppointmentItem
Dim MySheet As Worksheet

Set olApp - New Outlook.Application
Set OutMail = olApp.CreateItem(olAppointmentItem)
Set MySheet = Worksheets("Tracker")

Cont COL_FLAG As Long = 18 'adds a column to my table - used to avoid duplicating appointments

For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Len(Cells(r, COL_FLAG).Value) = 0 Then

With OutMail

.MeetingStatus = olMetting
.Start = Cells(r, 2).Value + Cells(r, 3).Value
.Duration = "0"
.Subject = Cells(r, 10).Value & " (" & Cells(r, 14).Value & Cells(r, 15).Value & ")"
.Location = Cells(r, 6).Value
.Body = "Follow up with task lead"
.BusyStatus = olBusy
.ReminderMinutesBeforeStart = 120
.Categories = Cells(r, 4).Value
.ReminderSet = True
'.Save
.RequiredAttendees = ("me@me.com")
.Display

Cells(r, COL_FLAG).Value = "Created"

End With
End If
Next

Set olApt = Nothing
Set olApp = Nothing

End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
category of appointments from PENDING to CLOSED if I have changed it to CLOSED in the table?
if you change it to closed in the excel sheet, you should use an 'update' macro that searches the calendar for matches and updates the found entry. You may need to use a column to show the appt was updated, so the macro doesn't lookup all entries with closed as the category.

You'll need a filter - this sample uses the subject to find the appt, but you could use other values too.

Code:
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & strsubject & "%'"
Debug.Print strFilter
Set filteredItems = objCalendarFolder.Items.Restrict(strFilter)

If filteredItems.count = 0 Then
    Debug.Print "None found"
Else
    Found = True
For Each objItem In filteredItems
 objitem.category = "Closed"
objitem.save
next
Thos page: How to print a list of recurring dates using VBA shows how to filter by dates.
 

Kevin8675309

New Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server
if you change it to closed in the excel sheet, you should use an 'update' macro that searches the calendar for matches and updates the found entry. You may need to use a column to show the appt was updated, so the macro doesn't lookup all entries with closed as the category.

You'll need a filter - this sample uses the subject to find the appt, but you could use other values too.

Code:
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & strsubject & "%'"
Debug.Print strFilter
Set filteredItems = objCalendarFolder.Items.Restrict(strFilter)

If filteredItems.count = 0 Then
    Debug.Print "None found"
Else
    Found = True
For Each objItem In filteredItems
 objitem.category = "Closed"
objitem.save
next
Thos page: How to print a list of recurring dates using VBA shows how to filter by dates.
Thanks! How do I incorporate my subject, which is a string (see .subject line), into the strFilter?
.Subject = Cells(r, 10).Value & " (" & Cells(r, 14).Value & Cells(r, 15).Value & ")"
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
strSubject = Cells(r, 10).Value & " (" & Cells(r, 14).Value & Cells(r, 15).Value & ")"
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & strsubject & "%'"
Debug.Print strFilter
 
Top