Copy contacts from public folder to mailbox
Yo!
I am trying to keep a public contacts folder in sync with a contacts folder
in a users mailbox. I setup an event sink and have the following code:
Sub ExStoreEvents_OnSave(pEventInfo, bstrURLItem, lFlags)
set rs = CreateObject("ADODB.Record")
set contobj1 = createobject("CDO.Person")
set contobj2 = createobject("CDO.Person")
set conn = CreateObject("ADODB.Connection")
sItem = Right(bstrURLItem, Len(bstrURLItem) - InstrRev(bstrURLItem, "/"))
sDestURL =
"file://./backofficestorage/exite.nl/mbx/testuser/contacts/exite/" & sItem
conn.Provider = "ExOLEDB.DataSource"
rs.Open bstrURLItem, , adModeReadWrite
ourl = rs.fields("http://schemas.microsoft.com/exchange/permanenturl")
contobj1.datasource.open ourl,,3
set stm = contobj1.getvcardstream()
set stm1 = contobj2.getvcardstream()
stm1.writetext = stm.readtext
stm1.flush
contobj2.fields("urn:schemas:contacts:fileas") =
contobj1.fields("urn:schemas:contacts:fileas")
contobj2.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x8080")
=
contobj1.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x8080")
contobj2.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x818A")
=
contobj1.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x818A")
contobj2.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x818B")
=
contobj1.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x818B")
contobj2.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x818C")
=
contobj1.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x818C")
contobj2.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x818D")
=
contobj1.fields("http://schemas.microsoft.com/mapi//id/{00062004-0000-0000-C000-000000000046}/0x818D")
contobj2.fields("http://schemas.microsoft.com/mapi/proptag/0x3A15001E") =
contobj1.fields("http://schemas.microsoft.com/mapi/proptag/0x3A15001E")
contobj2.fields("http://schemas.microsoft.com/mapi/proptag/0x3A2A001E") =
contobj1.fields("http://schemas.microsoft.com/mapi/proptag/0x3A2A001E")
contobj2.fields("http://schemas.microsoft.com/mapi/proptag/0x3A2B001E") =
contobj1.fields("http://schemas.microsoft.com/mapi/proptag/0x3A2B001E")
contobj2.fields.update
contobj2.datasource.saveto sDestURL
set stm = nothing
set stm1 = nothing
set contobj1 = nothing
set contobj2 = nothing
set rs = nothing
End Sub
Most of this I found on newsgroups and the Internet.
It works, but is does not copy all of the contacts details. The subjects
changes (gets an .EML extention), the user fields are not being copied etc.
What am I missing? Isn't there a simple way to copy the contact records with
all details intact?
I can't use the copyrecord method because it is in different stores....
Thanks!