Thursday, September 23, 2004

Copying Contacts from One Mailbox to Another via Script

I had this request from one of my customers recently who wanted me to copy all the contacts from one mailbox into another. The easiest way to do this would have been to use outlook to export the contacts folder to a pst and then just import them back into the other mailbox using Outlook. Because i manage this client remotely and there's no Outlook on the Exchange server itself (and i really didn't feel like talking the users though this) I came up with the following Exoledb/CDOEX script to do the copy. The challenge when copying anything between mailbox's or public folders is you cant do a direct copy (eg ADO copyrecord only works within a mailbox or public store) so you have to use another solution.

What this script does is first does a query to get all the URL's of contacts in the mailbox's contact folder. Then it opens up each contact using the CDO.Person interface and then access's the vcard stream on each contact object . The script then copies this vcard stream into a new CDO.Person object and then saves it to the store which will then gernerate all the nessasary MAPI contact properties based on the information that is in the vCard Stream. The vCard stream has most of the information needed to create the contact as it was in the source mailbox but there are a few specific MAPI properties that are missing to be able to replicate this exactly. The first of these is the fileas property which ensures that when you recreate the contact they will be listed in the same order as they where in the source mailbox. The other import one that needs to be copied is the postal address, the business address gets copied in the vCard stream but the postal address doesn't and Outlook actually uses the postal address to display the address in the normal contact view . Some other things that don't copy over properly when you use the vCard stream is the email displayname and if you have a X400 address instead of a SMTP address this also get mangled so I've included code that copies each of those address properties manually. I've only included the properties for the first email contact field (if you want the 2nd and 3rd you'll have to get them yourself).

I've posted a copy of the script up here

here's what the code looks like

on error resume next
Set Rs = CreateObject("ADODB.Recordset")
set Rec = CreateObject("ADODB.Record")
set contobj = createobject("CDO.Person")
Set Conn = CreateObject("ADODB.Connection")
contactfolderurl = "file://./backofficestorage/"
Conn.Provider = "ExOLEDB.DataSource"
Rec.Open contactfolderurl, ,3
SSql = "Select ""DAV:href"", """" "
SSql = SSql & " FROM scope('shallow traversal of """ & contactfolderurl & """') "
SSql = SSql & "WHERE ""DAV:contentclass"" = 'urn:content-classes:person' and ""DAV:ishidden"" = false"
Rs.CursorLocation = 3 'adUseServer = 2, adUseClient = 3
Rs.CursorType = 3 SSql, rec.ActiveConnection, 3
if Rs.recordcount <> 0 then
while not rs.eof
set contobj1 = createobject("CDO.Person")
wscript.echo rs.fields("DAV:href")
ourl = rs.fields("") ourl,,3
set stm = contobj.getvcardstream()
set stm1 = contobj1.getvcardstream()
stm1.writetext = stm.readtext
contobj1.fields("urn:schemas:contacts:fileas") = contobj.fields("urn:schemas:contacts:fileas")
contobj1.fields("{00062004-0000-0000-C000-000000000046}/0x8080") = contobj.fields("{00062004-0000-0000-C000-000000000046}/0x8080")
contobj1.fields("{00062004-0000-0000-C000-000000000046}/0x818A") = contobj.fields("{00062004-0000-0000-C000-000000000046}/0x818A")
contobj1.fields("{00062004-0000-0000-C000-000000000046}/0x818B") = contobj.fields("{00062004-0000-0000-C000-000000000046}/0x818B")
contobj1.fields("{00062004-0000-0000-C000-000000000046}/0x818C") = contobj.fields("{00062004-0000-0000-C000-000000000046}/0x818C")
contobj1.fields("{00062004-0000-0000-C000-000000000046}/0x818D") = contobj.fields("{00062004-0000-0000-C000-000000000046}/0x818D")
contobj1.fields("") = contobj.fields("")
contobj1.fields("") = contobj.fields("")
contobj1.fields("") = contobj.fields("")
contobj1.datasource.savetocontainer "file://./backofficestorage/"
wscript.echo err.description
set stm = nothing
set stm1 = nothing
set contobj1 = nothing
end if