I need to add a user defined property to each mail item in a folder. The code below works without errors but it only adds the property to the currently selected mail item or the first mail item in a selected group of items. How can I make it work for every item in the folder? Thanks.

[VBA]
Option Explicit

Sub AddAUserDefinedProperty()

Dim olApplication As Outlook.Application
Dim olNameSpace As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim objItem As Object
Dim strDomain As String
Dim olProperty As Outlook.UserProperty

Set olApplication = New Outlook.Application
Set olNameSpace = olApplication.GetNamespace("Mapi")
Set olFolder = olNameSpace.GetDefaultFolder(olFolderJunk)

For Each olItem In olFolder.Items

strDomain = Mid(olItem.SenderEmailAddress, _
InStr(1, olItem.SenderEmailAddress, "@") + 1)

Set olProperty = olItem.UserProperties.Add("Domain", olText)

olProperty.Value = strDomain

Debug.Print olItem.SenderEmailAddress, olProperty.Value

Next olItem

Set olApplication = Nothing
Set olNameSpace = Nothing
Set olFolder = Nothing
Set olProperty = Nothing

End Sub
[/VBA]