VBA Excel, im Outlook Kalender Kategorien in verschiedenen Postfächer erstellen

 
Sub Testxy()
Dim oOutlookApp As Object
Dim Mapi As Object, oCat As Object

Set oOutlookApp = CreateObject("Outlook.Application")  

Set objCal = oOutlookApp.Session.Stores.Item(Range("C1").Value).GetDefaultFolder(9)  

'Kategorie erstellen'  

Set Mapi = oOutlookApp.GetNamespace("Mapi")  

If Range("g2").Value <> "" Then  
    For Each oCat In Mapi.Categories
        If oCat.Name = Range("g2").Value Then  
            Exit For
        End If
            
    Next
    If oCat Is Nothing Then
        Set oCat = Mapi.Categories.Add(Range("g2").Value, enuCatColor.Schwarz)  
    End If
    End If
End Sub