Get first recipient from a specified domain and create user property

[SvenBlomme]

Hi,

I'm trying to find a way to add a user defined property to incoming email and to display this in a user defined field.
The idea is that, for every incoming message, I want to check every recipient to determine who is the first recipient (either in TO or in CC) from a specific domain (my company), and to display this person's name or email address in an additinoal column (by adding this name or address as a user defined property to the incoming message). When I test the below code I don't get any error messages but the user defined field is not populated.

Here is what I have so far;

Sub Filer(Item As Outlook.MailItem)

Dim olkUDP2 As Outlook.UserProperty
Dim recip As Outlook.Recipient
Dim udp2value As String
Dim i As Long

If Item.Class = olMail Then


For i = 1 To Item.Recipients.Count
Set recip = Item.Recipients.Item(i)
If InStr(recip.Address, "mycompanydomain") > 0 Then
Set olkUDP2 = Item.UserProperties.Add("Filer", olText, True)
olkUDP2 = recip.Address
Exit For
End If
Next i

End Sub


Can anybody tell me what I am doing wrong?

[gmayor]

You are an 'End If' and a '.Save' missing but apart from that it seems to work e.g. If I change to my domain then

Sub Filer(item As Outlook.MailItem)
Dim olkUDP2 As Outlook.UserProperty
Dim recip As Outlook.Recipient
Dim udp2value As String
Dim i As Long
    If item.Class = olMail Then
        For i = 1 To item.Recipients.Count
            Set recip = item.Recipients.item(i)
            If InStr(recip.Address, "gmayor.com") > 0 Then
                Set olkUDP2 = item.UserProperties.Add("Filer", olText, True)
                olkUDP2.Value = recip.Address
                Exit For
            End If
        Next i
        item.Save
    End If
End Sub

will work for my domain. Use the following macro to read the value

Sub GetFiler(item As Outlook.MailItem)
Dim olkUDP2 As Outlook.UserProperty
    Set olkUDP2 = item.UserProperties("Filer")
    MsgBox olkUDP2.Value
End Sub

You can use the following to apply or test the property

Sub GetMsg()
Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.item(1)
    GetFiler olMsg 'Read the value
    'Filer olMsg 'Write the value
lbl_Exit:
    Exit Sub
End Sub

[SvenBlomme]

Hi Graham,

At first glance it seems like it's working perfectly! I will need to test this a bit more but thanks a million for your support! I'll mark this thread as solved for now.

Best,
Sven