Need to Add a Userdefined Property to Mail Items...

[jmrdaddy]

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]

[chocobochick]

Check your variable names. You named "objItem" in your declarations, but used "olItem" for your loop. Considering you specified the Option Explicit statement, I'm surprised your code runs at all.

What version of Outlook are you using?

[jmrdaddy]

you are absolutely correct. i was "cleaning" up. i changed it in that one place in the post but forgot to change it everywhere. with that change it does run but with undesired results. what would you suggest after that correction?

[jmrdaddy]

outlook 2003

[chocobochick]

Hmm... unfortunately, I only have Outlook 2000, which does not include the SenderEmailAddress property new to 2003. However, I do know that extracting any types of email addresses in Outlook 2000 is an absolute pain in the rear, as a security update by Microsoft prevents access to any email address properties without explicit confirmation in the form of a run-time popup. I'd be surprised if Microsoft had actually removed that restriction in 2003, and it might be possible the restrictions on this property are hindering your loop.

To test it, try commenting out any lines which reference the SenderEmailAddress property, and set strDomain to a constant string such as "vbaexpress.com". Add or change a Debug.Print line to display only olItem.Subject, and then run your script. What the Debug.Print line sends to the Immediate window might give you a clue as to what items it's running the loop against.

[TonyJollans]

Hi jmrdaddy,

Welcome to VBAX!

For reference this is also posted at Tek-Tips

I think you need to save the mailitem after changing it (adding the property).[vba]Option Explicit

Sub AddAUserDefinedProperty()

Dim olApplication As Outlook.Application
Dim olNameSpace As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olItem 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

olItem.Save

Next olItem

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

End Sub[/vba]

[jmrdaddy]

Well, duh! I use a macro similar to this every day. You're awesome! Thank you!

[jmrdaddy]

i don't know how to give you stars like on Tek-Tips.

[TonyJollans]

Just happy you're sorted!

I think there is some method for starring the thread (not the person) but I don't have any real interest in it and haven't a clue how to do it.