Sub Sync_GTD()

Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.ActiveInspector.CurrentItem
Dim GTD_Project As Outlook.UserProperty
Set GTD_Project = myItem.UserProperties.Find("Project")
Dim GTD_Action As Outlook.UserProperty
Set GTD_Action = myItem.UserProperties.Find("Action")
Dim Cat_List As Variant
        
If TypeName(GTD_Project) <> "Nothing" Then
'                                           This means GTD Project is present
    Next_Project = "p:" & myItem.UserProperties("Project")
    Next_Action = myItem.UserProperties("Action")
    Cat_List = Array(Next_Action, Next_Project)
    myItem.Categories = Join(Cat_List, ",")
    
myItem.Close olSave
Exit Sub
  
  Else
  
  arr = Split(myItem.Categories, ",")
'                                                   arr is the array of Categories
   If UBound(arr) >= 0 Then
'                                                   item has categories, Assume two categories from Next Action
'                                                   For I = 0 To UBound(arr)
'
         If InStr(1, Trim(arr(0)), "p:") > 0 Then
'                                                   The Project will have p:
            ProjName = Mid(Trim(arr(0)), 3)
            ActionName = Trim(arr(1))
         Else
            ProjName = Mid(Trim(arr(1)), 3)
            ActionName = Trim(arr(0))
        End If

    End If
    
'myItem.Subject = myItem.Subject & "Project:" & ProjName & " Action: " & ActionName
Set GTDProj = myItem.UserProperties.Add("Project", olText)
GTDProj.Value = ProjName

Set GTDAction = myItem.UserProperties.Add("Action", olText)
GTDAction.Value = ActionName

End If

myItem.Close olSave

End Sub