Contacts from inbox emails script    Download script

The following script generates a contacts folder (called inbox-address-list) within your contacts folder in your Exchange 2000 mailbox and then populates it with contact entries that are derived by going through each mail in you inbox and generating a new contact entry for each sender address.

This can have a variety of applications (other then a outlet for my over active imagination) ranging from providing extra functionality for users eg who hasn't  been typing up an email only to realise that you have forgotten that persons email address and now your going to have to go back and search through your entire inbox for that email that contained their address, well here's a way to add all those address's to your outlook address book. It can also be useful when migrating from another email system where the budget doesn't stretch to doing address book migrations this can be used to quickly generate a new set of contacts for your migrated users.

How does it work

This script uses both EXCDO and EXOLEDB so it must be run on the exchange sever where the mailboxes exists. The front end of the code accepts the target mailbox (mailbox alias) as a parameter of running the script. You need to customise this bit of code with you own exchange domain name. if you not sure what it is have a look at the M: drive on you server.

inbstr1 = "file://./backofficestorage/yourdomain/mbx/" & inbstr & "/contacts"
inbstr2 = inbstr1 & "/inbox-address-list"
inbstr3 = "file://./backofficestorage/yourdomain/mbx/" & inbstr & "/inbox"

 The next part of the code sets up the necessary EXOLDDB parameters for connection to the mailbox and then sets up for the first real function of the code which checks to see if there's a folder called inbox-address. Because there is no "if exist code" that will work to check for the existence of the folder the code opens a record set with a select statement if the record set contains no records then the folder doesn't exist so the next part of the code creates the folder using the Ifolder interface of EXOLDB.

strView = "SELECT ""DAV:href"",""DAV:displayname"""
strView = strView & "FROM scope ('shallow traversal of """& inbstr1 & """') "
strview = strview & "WHERE ""DAV:isfolder"" = true AND ""DAV:displayname"" = 'inbox-address-list"
rs.CursorLocation = 3 'adUseServer = 2, adUseClient = 3
rs.CursorType = 3
Rs.Open strView, Rec.ActiveConnection, 2
If Rs.RecordCount = 0 Then
        set Fldr = CreateObject("CDO.Folder")
        Fldr.ContentClass = "urn:content-classes:contactfolder"
        Fldr.Fields("DAV:contentclass").Value = "urn:content-classes:contactfolder"
        Fldr.Fields("http://schemas.microsoft.com/exchange/outlookfolderclass").Value = "IPF.Contact"
        Fldr.Fields.update
        Fldr.DataSource.SaveTo inbstr2
end if
rs.close

After the folder has been created the next part of the code creates two recordsets :

The first record set contains any contacts that exist in the inbox-address folder, this is to cater for running the script consecutively so no existing entries are overwritten.
The Second recordset contains all the emails in your inbox, the next part of the code is a loop that goes through each email in your inbox looks at the sender address and checks to see if a contact already exists for that email in the first record set, if it doesn't then it creates a contact entry using the information obtained from the sender address and display name.

strView = "SELECT ""DAV:displayname"",""DAV:href"",""urn:schemas:contacts:email1"""
strView = strView & "FROM scope ('shallow traversal of """& inbstr2 & """') "
strview = strview & " WHERE ""DAV:isfolder"" = false AND ""DAV:ishidden"" = false"
Rs.Open strView, Rec.ActiveConnection, 2
strView = "SELECT ""DAV:displayname"",""DAV:href"",""urn:schemas:httpmail:fromname"",""urn:schemas:httpmail:fromemail"",""urn:schemas:httpmail:from"""
strView = strView & "FROM scope ('shallow traversal of """& inbstr3 & """') "
strview = strview & " WHERE ""DAV:isfolder"" = false AND ""DAV:ishidden"" = false"
Rec1.Open inbstr3
rs1.CursorLocation = 3 'adUseServer = 2, adUseClient = 3
rs1.CursorType = 3
Rs1.Open strView, Rec1.ActiveConnection, 2
If Rs1.RecordCount <> 0 Then
	Rs1.Movefirst
	While Not Rs1.EOF
		stext1 = Rs1.fields("urn:schemas:httpmail:fromname").Value
		isitthere = 0
		Rs.Find "DAV:displayname = '" & stext1 & "'"
		While Not Rs.EOF
			isitthere = 1
			rs.Movelast
			rs.Movenext
		Wend
		if isitthere = 0 then
			stext2 = Rs1.fields("urn:schemas:httpmail:fromname").Value
			rem tsg = msgbox(instr(stext2,"="))
			if instr(stext2,"=") then
				rem ignore it
			else
				on error resume next
				set oPerson = CreateObject("CDO.Person")
				oPerson.Email = Rs1.fields("urn:schemas:httpmail:fromemail").Value
				oPerson.lastname = Rs1.fields("urn:schemas:httpmail:fromname").Value
				operson.Fields("urn:schemas:mailheader:subject") = Rs1.fields("urn:schemas:httpmail:fromname").Value
				oPerson.Fields("objectClass").Value = "contact"
				oPerson.Fields.Update
				strURL =  Rs1.fields("urn:schemas:httpmail:fromname") & ".eml"
				strURL =  inbstr2 & "/" & strURL
				oPerson.DataSource.SaveTo strURL
				set oPerson = nothing
			end if
		end if
		rs1.movenext
	wend
end if

Code Features (Bugs )

For those astute people that may have noticed a fatal flaw in the logic of this code, if you have two emails from the same person in your inbox then this is going to result in an attempt to create two contacts with the same name, and yes this does create an error at runtime. There are a few ways to handle this, one is to keep reopening the first record set so it contains the updated contact entries. The other (which is the method I've used) is to put an "on error resume next" in that section of the code and ignore the errors created by duplicates. For me this gives the best performance because you are not reopening the recordset all the time. The other one which I can't explain is to set the email display name of a contact you use the .Fields("urn:schemas:mailheader:subject") of the Iperson interface its documented fairly obscurely in the Exchange 2000 SDK but they never explain anywhere what it does (I think they want you to guess).

Seeing this folder in your outlook address book

Remember if you want to see this folder in your outlook address book you need to right click on the folder in Outlook and then select the show this folder as an address book in the Outlook address book tab. This setting is stored in your Mapi profile.

Going further

This code has a lot of room to grow you could do things such as schedule this script to run regularly on your server so it updates people's inbox-address-list folders on a ongoing basis. You could also modify some of the parameters of the code and create a sent-mail folder script that picked up the sent-to address's and created a separate folder of contacts for these entries. For those people who have really tidy inboxes you could change the queries used in this code to recursively go though all inbox folders and generate contacts from all emails in all inbox  folders. For ideas on this please see me other article on mailbox crawling.

Download script