VBA update outlook calendar category

[omnivl]

Hi

I have the following code that works well but i cannot seem to get the category color to work
any ideas?

Option Explicit



Sub AddToOutlook()

    Dim OL As Outlook.Application
    Dim olAppt As Outlook.AppointmentItem
    Dim NS As Outlook.Namespace
    Dim colItems As Outlook.Items
    Dim olApptSearch As Outlook.AppointmentItem
    Dim r As Long, sSubject As String, sBody As String
    Dim dStartTime As Date, dDuration As Double
    Dim sSearch As String, bOLOpen As Boolean

    On Error Resume Next
    Set OL = GetObject(, "Outlook.Application")
    bOLOpen = True
    If OL Is Nothing Then
        Set OL = CreateObject("Outlook.Application")
        bOLOpen = False
    End If
    Set NS = OL.GetNamespace("MAPI")
    Set colItems = NS.GetDefaultFolder(olFolderCalendar).Items

    For r = 2 To 500

        If Len(Sheets("ProcurementContracts").Cells(r, 11).Value) = 0 Then GoTo NextRow
        sSubject = Sheets("ProcurementContracts").Cells(r, 2).Value & " - " & Sheets("ProcurementContracts").Cells(r, 3).Value
        sBody = Sheets("ProcurementContracts").Cells(r, 13).Value
        dStartTime = Sheets("ProcurementContracts").Cells(r, 11).Value
        dDuration = 30

        sSearch = "[Subject] = " & sQuote(sSubject)
        'sSearch = "[Body] = Account " & sQuote(sBody)
        Set olApptSearch = colItems.Find(sSearch)

        If olApptSearch Is Nothing Then
            Set olAppt = OL.CreateItem(olAppointmentItem)
            olAppt.Body = "Account " & sBody
            olAppt.Subject = "Procurement - " & sSubject
            'olAppt.Subject = sSubject
            olAppt.Start = dStartTime
            olAppt.Duration = dDuration
            olAppt.Categories = "Red"
            olAppt.Close olSave
        End If

NextRow:
    Next r

    If bOLOpen = False Then OL.Quit

End Sub

Function sQuote(sTextToQuote)
    sQuote = Chr(34) & "Procurement - " & sTextToQuote & Chr(34)
End Function

 

[John_w]

Try:

olAppt.Categories = "Red Category"

 

[omnivl]

Try:

olAppt.Categories = "Red Category"

Ah perfect thankyou!