Outlook 2010

Yes so 23 new contacts will mean 23 new contacts named "Please Name ME" ... or whatever you change that string to.

The code is below and your rule that you create needs to call the code routine rule_1, (run a script when defining the rule)

Chris


To Create a macro:
------------------

Alt + F11 to open the macro editor

  For User Code:
     Insert | Module to insert a code module into the project
     In the project tree select the module.
     Insert the required macro(s) into the selected module, ('Module1' or similar)

Close the Visual Basic Editor.

Function findContact(streMail As String) As ContactItem
Dim conFolder As MAPIFolder
Dim strFilter As String
Dim olkContactItems As items
Dim con As ContactItem
Dim intCountItems As Integer
Dim intDelCount As Integer

    Set conFolder = Application.Session.GetDefaultFolder(olFolderContacts)
    strFilter = "[email1address] = " & Chr(34) & streMail & Chr(34)
    Set olkContactItems = conFolder.items.Restrict(strFilter)
    If olkContactItems.count <> 0 Then
        Set findContact = olkContactItems.GetFirst
    Else
        strFilter = "[email2address] = " & Chr(34) & streMail & Chr(34)
        Set olkContactItems = conFolder.items.Restrict(strFilter)
        If olkContactItems.count <> 0 Then
            Set findContact = olkContactItems.GetFirst
        Else
            strFilter = "[email3address] = " & Chr(34) & streMail & Chr(34)
            Set olkContactItems = conFolder.items.Restrict(strFilter)
            If olkContactItems.count <> 0 Then
                Set findContact = olkContactItems.GetFirst
            End If
        End If
    End If

End Function

Sub rule_1(mai As MailItem)
Dim con As Object

    If mai.SenderEmailType <> "SMTP" Then Exit Sub
    Set con = findContact(mai.sendereMailAddress)
    If con Is Nothing Then
        Set con = Application.CreateItem(olContactItem)
        con.FullName = "Please Name ME"
        con.Email1Address = mai.sendereMailAddress
        con.Save
    End If
End Sub

Select all Open in new window