P
PGT
Below i wrote code to assign a categorie to a calendar item based on the word "vrij" in the subject.
I got to automate a lot of words for a lot of people so this just the first keyword.
I think this code should work.. but somehow it doesnt
I use Outlook 2003 with macro security set to lowest level. The code is placed in "this outlook session"
Any ideas why it doesnt work ??
> ====================================================
Dim WithEvents colRDVItems As Items
Private Sub Application_Startup()
Dim NS As Outlook.NameSpace
Set NS = Application.GetNamespace("MAPI")
Set colRDVItems = NS.GetDefaultFolder(olFolderCalendar).Items
Set NS = Nothing
End Sub
Private Sub colRDVItems_ItemAdd(ByVal Item As Object)
If Item.Class = olAppointment Then
If InStr(LCase(Item.Subject), "vrij") > 1 Then
AddCat Item, "Holiday"
Item.Save
End If
End If
End Sub
Sub AddCat(itm, catName)
arr = Split(itm.Categories, ",")
If UBound(arr) >= 0 Then
' item has categories
For I = 0 To UBound(arr)
If Trim(arr(I)) = catName Then
' category already exists on item
' no need to add it
Exit Sub
End If
Next
itm.Categories = itm.Categories & "," & catName
Else
' item has no categories
itm.Categories = catName
End If
End Sub
I got to automate a lot of words for a lot of people so this just the first keyword.
I think this code should work.. but somehow it doesnt
I use Outlook 2003 with macro security set to lowest level. The code is placed in "this outlook session"
Any ideas why it doesnt work ??
> ====================================================
Dim WithEvents colRDVItems As Items
Private Sub Application_Startup()
Dim NS As Outlook.NameSpace
Set NS = Application.GetNamespace("MAPI")
Set colRDVItems = NS.GetDefaultFolder(olFolderCalendar).Items
Set NS = Nothing
End Sub
Private Sub colRDVItems_ItemAdd(ByVal Item As Object)
If Item.Class = olAppointment Then
If InStr(LCase(Item.Subject), "vrij") > 1 Then
AddCat Item, "Holiday"
Item.Save
End If
End If
End Sub
Sub AddCat(itm, catName)
arr = Split(itm.Categories, ",")
If UBound(arr) >= 0 Then
' item has categories
For I = 0 To UBound(arr)
If Trim(arr(I)) = catName Then
' category already exists on item
' no need to add it
Exit Sub
End If
Next
itm.Categories = itm.Categories & "," & catName
Else
' item has no categories
itm.Categories = catName
End If
End Sub