• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 593
  • Last Modified:

Extract contacts from a recipient list

Dear Outlook Experts,

I am running Outlook 2000.

Very often, when I get an email message, I will right-click on a name/address in the To, From, and/or CC fields and
add that person as a Contact item.

I would like to have a macro that will automate this process for every recipient in the mail item currently active.
Ideally, I would like to get MsgBoxes at the start asking whether I want to include the To, From, and/or CC fields.

If you need any clarifying info, please ask away!

Patrick
0
Patrick Matthews
Asked:
Patrick Matthews
  • 8
  • 8
1 Solution
 
David LeeCommented:
Hi Patrick,

I can write a macro that'll do this easily enough, but using it may not prove so easy.  The problem is Outlook's security which has been beefed up to combat all the viruses and worms that've been written to use it as a transport mechanism.  As a result any time code accesses an email address field, which this macro would do, you're going to get a pop up dialog-box saying that a program is accessing your mailbox and asking you for permission to allow it to continue.  If you don't see that as a problem, then let me know and I'll put the macro together.

Cheers!
0
 
Patrick MatthewsAuthor Commented:
David,

I am aware of those security message boxes, and I suspect my company simply has not implemented those security
protocols, because I do not get them when I do things like automate the creation and sending of an Outlook MailItem
from an Excel VBA project.  Even if it will trigger the security message, I would still find it more convenient than
right-clicking on every recipient in a 40+ person email message.

:)

So yes, please do go ahead and write that macro.

Regards,

Patrick
0
 
Patrick MatthewsAuthor Commented:
David,

BTW, seeing that you have a Master cert in Win2000, if you feel like having a go at a separate Win98 problem I am
having (different computer from the one I'm running Outlook 2000 on):
http://www.experts-exchange.com/Operating_Systems/Win98/Q_21414995.html

Regards,

Patrick
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
David LeeCommented:
Patrick,

Ok, I'll whip the macro up and post it as soon as I can.  I'll also have a look at the other question.

-- David
0
 
David LeeCommented:
matthewspatrick,

Here's the code for doing this.  I just noticed that you said in your post you're using Outlook 2000.  I don't have access to Outlook 2000 any more so I'm not 100% sure this is going to run straight away.  I wrote and tested it using Outlook 2002 and it worked perfectly.  Frankly, I haven't used or done anythng with 2000 in a long time and don't remember all of its details.  If this doesn't run, then let me know and I'll try and work the bugs out as best I can given that I don't have 2000.

Here's what you'll need to do to use this.
1.  Start Outlook
2.  Click Tools->Macro->Visual Basic Editor
3.  If not already expanded, expand Modules and click on Module1
4.  Copy the code below and paste it into the right-hand pane of the VB editor
5.  Click File->Save VbaProject.OTM to save the code changes
6.  Close the VB editor
7.  Click Tools->Macro->Security  (This step and step 8 may not apply to 2000.)
8.  Change the Security Level to Medium
9.  Open a mail item, then run the macro.  I dialog-box should appear asking which address types you want to add contacts for.  Enter 1, 2, 3, 4, or any combination of those.  For example, to create contacts for the From and CC addresses, enter 13.  Or, if all you want is the To addresses, enter 2.  Click OK and the code will create a contact entry for each address in the chosen category.  Of course all it can fill in is the name and email address.  And it does no checking to see if there's a contact with that name already.  


'Macro Begins Here
Sub AutoCreateContacts()
    Dim objMailItem As Outlook.MailItem, _
        objRecipientList As Outlook.Recipients, _
        objRecipient As Outlook.Recipient, _
        objReply As Outlook.MailItem, _
        strIncludeType As String, _
        bolFrom As Boolean, _
        bolTo As Boolean, _
        bolCC As Boolean, _
        bolBCC As Boolean
    strIncludeType = InputBox("Which addresses would you like to add to contacts" & vbCrLf & "(1=From, 2=To, 3=CC, 4=BCC)?", "Auto Create Contacts", "1")
    If strIncludeType <> "" Then
        Set objMailItem = Application.ActiveInspector.CurrentItem
        Set objRecipientList = objMailItem.Recipients
        bolFrom = InStr(1, strIncludeType, "1") > 0
        bolTo = InStr(1, strIncludeType, "2") > 0
        bolCC = InStr(1, strIncludeType, "3") > 0
        bolBCC = InStr(1, strIncludeType, "4") > 0
        If bolFrom Then
            Set objReply = objMailItem.Reply
            CreateNewContact objReply.Recipients(1).Name, objReply.Recipients(1).Address
        End If
        For Each objRecipient In objRecipientList
            Select Case objRecipient.Type
                Case olTo
                    If bolTo Then
                        CreateNewContact objRecipient.Name, objRecipient.Address
                    End If
                Case olCC
                    If bolCC Then
                        CreateNewContact objRecipient.Name, objRecipient.Address
                    End If
                Case olBCC
                    If bolBCC Then
                        CreateNewContact objRecipient.Name, objRecipient.Address
                    End If
            End Select
        Next
    End If
    Set objReply = Nothing
    Set objRecipient = Nothing
    Set objRecipientList = Nothing
    Set objMailItem = Nothing
End Sub

Private Sub CreateNewContact(strName As Variant, strAddress As Variant)
    Dim objContact As Outlook.ContactItem
    Set objContact = Application.CreateItem(olContactItem)
    With objContact
        .FullName = strName
        .Email1Address = strAddress
        .Save
    End With
    Set objContact = Nothing
End Sub
'Macro Ends Here
0
 
Patrick MatthewsAuthor Commented:
David,

Thanks.  I will test it in a little while.  A couple of questions to see if I understand what's going on...

When I get the InputBox, if I wanted to do, say, From and CC, would I enter '13'?

Also, I am surprised that the BCC recipients are accessible!  Or is that just if the active MailItem is one I created?

Regards,

Patrick
0
 
David LeeCommented:
Patrick,

Yes, 13 would get you the From and CC addresses.  1 alone would get From and 3 alone would get CC.  The two together, but not added together (i.e. 1 and 3 not 1 + 3) gets both.  You can also space the entries out or separate them with commas if you want to.  The routine doesn't care.  And there's no order dependency either.  31 in this case will work just as 13.  So would 1 3 or 1,3.  The code merely looks to see if each number (1 - 4) is present.

Correct, the BCC recipients aren't available unless it's a message you created.  

-- David
0
 
Patrick MatthewsAuthor Commented:
David,

Bravo!  I love it!

I made a couple of tweaks, covering things that I discovered I wanted in testing but never actuall put in the question.

The additions: the ability to add a Company designation to the batch of contacts (usually they will all be from the same company),
and some parsing of the name (if the name looks like an email address, strip out the domain info and convert underscores and periods
to spaces).

Here is the version I implemented:

Sub AutoCreateContacts()
    Dim objMailItem As Outlook.MailItem, _
        objRecipientList As Outlook.Recipients, _
        objRecipient As Outlook.Recipient, _
        objReply As Outlook.MailItem, _
        strIncludeType As String, _
        bolFrom As Boolean, _
        bolTo As Boolean, _
        bolCC As Boolean, _
        bolBCC As Boolean, _
        strCompany As String
    strIncludeType = InputBox("Which addresses would you like to add to contacts" & vbCrLf & "(1=From, 2=To, 3=CC, 4=BCC)?", "Auto Create Contacts", "1")
    If strIncludeType <> "" Then
        strCompany = InputBox("What company are these contacts from?", "Use Company Name?")
        Set objMailItem = Application.ActiveInspector.CurrentItem
        Set objRecipientList = objMailItem.Recipients
        bolFrom = InStr(1, strIncludeType, "1") > 0
        bolTo = InStr(1, strIncludeType, "2") > 0
        bolCC = InStr(1, strIncludeType, "3") > 0
        bolBCC = InStr(1, strIncludeType, "4") > 0
        If bolFrom Then
            Set objReply = objMailItem.Reply
            CreateNewContact EvaluateRecipientName(objReply.Recipients(1).Name), _
                objReply.Recipients(1).Address, strCompany
        End If
        For Each objRecipient In objRecipientList
            Select Case objRecipient.Type
                Case olTo
                    If bolTo Then
                        CreateNewContact EvaluateRecipientName(objRecipient.Name), _
                            objRecipient.Address, strCompany
                    End If
                Case olCC
                    If bolCC Then
                        CreateNewContact EvaluateRecipientName(objRecipient.Name), _
                            objRecipient.Address, strCompany
                    End If
                Case olBCC
                    If bolBCC Then
                        CreateNewContact EvaluateRecipientName(objRecipient.Name), _
                            objRecipient.Address, strCompany
                    End If
            End Select
        Next
    End If
    Set objReply = Nothing
    Set objRecipient = Nothing
    Set objRecipientList = Nothing
    Set objMailItem = Nothing
End Sub

Private Sub CreateNewContact(strName As Variant, strAddress As Variant, _
    Optional strCompany As String = "")
    Dim objContact As Outlook.ContactItem
    Set objContact = Application.CreateItem(olContactItem)
    With objContact
        .FullName = strName
        .Email1Address = strAddress
        .CompanyName = strCompany
        .Save
    End With
    Set objContact = Nothing
End Sub
Private Function EvaluateRecipientName(TestName As String)
   
    If InStr(1, TestName, "@") > 0 Then
        EvaluateRecipientName = Left(TestName, InStr(1, TestName, "@") - 1)
        EvaluateRecipientName = Replace(EvaluateRecipientName, "_", " ")
        EvaluateRecipientName = Replace(EvaluateRecipientName, ".", " ")
    Else
        EvaluateRecipientName = TestName
    End If
   
End Function
0
 
David LeeCommented:
Glad I was able to help out, Patrick.  I like the changes you made.  Very clever.  It's too bad that VBA has such a limited interface (just the MsgBox and InputBox).  If it included the ability to construct dialog-boxes, then it'd be possible to enhance the usefullness of this routine by popping up a dialog-box containing a checklist of the address so you could click just those you want rather than having to simply take them all by category.  It is possible to add that capability but only by creating and adding an ActiveX DLL to the system.
0
 
Patrick MatthewsAuthor Commented:
Thanks for the compliment :)  I am very comfortable using the Excel VBA object model, but I am a rank amateur
when it comes to the Outlook object model.

Doesn't Outlook support UserForms?  In the VB Editor, it appears I can insert a UserForm...

If I have some time later, I may look into that, because I really would like to have the ability to review the names
and check/uncheck as you described...

Patrick
0
 
David LeeCommented:
I figured you weren't new at this when I saw the changes.  I'm pretty much the reverse, good with Outlook and an amateur at the Excel model.  Yes, Outlook does support user forms inasmuch as you can create a custom form that's an alternative to the standard message, contact, appointment, etc forms.  But it doesn't support custom dialog boxes, or if it does then I'm blissfully ignorant of how to go about doing that.  If you're interested I can put together a DLL with a custom form that'll rpovide the capability I described.  I think that'd be an interesting exercise.

-- David
0
 
Patrick MatthewsAuthor Commented:
David,

I don't have a budget for this, so the most I can offer you is more points in a followup question or three :)

If you are still interested in doing it, please let me know.

Patrick
0
 
David LeeCommented:
No budget required, not even points.  I do most of this for fun, learning, and the mental exercise.  I'll see if I can come up with anything interesting.  If I do I'll post an update.

0
 
Patrick MatthewsAuthor Commented:
David,

I was so curious about harnessing UserForms, I went ahead and took a shot at it.  The following archive has the files necessary
to import a module and two UserForms.  The first UserForm asks what recipient types to use and what company name to
use.  The second UserForm lists the applicable names and email addresses, and allows the user to select/deselect at will.
Only the names selected on the second UserForm will have contact items created for them.

You gave me a terrific start!

www.geocities.com/matthewspatrick/AutoCreateContacts.zip

Regards,

Patrick
0
 
David LeeCommented:
Patrick,

Very nicely done and thanks for sharing the result!  I'm ashamed to admit that I was blissfully ignorant of UserForms so thanks for making me aware of them.  When I started playing around with programming Outlook I was using 98 and UserForms weren't available.  Somehow I missed their introduction.  Doh!

-- David
0
 
Patrick MatthewsAuthor Commented:
David,

Thanks for the compliment!  I use UserForms frequently for Excel work that I do.  They are pretty powerful, but
of course the more sophisticated you make them the more complex the code becomes.

Regards,

Patrick
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Microsoft Office 2010

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

  • 8
  • 8
Tackle projects and never again get stuck behind a technical roadblock.
Join Now