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.
Code:
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