Over the past week I’ve been working on some code to convert vcards from the Palm Desktop software into Contacts that can be stored in either the Outlook Contacts folder or a Public Contacts folder. You can read more about the vcard format at http://www.imc.org/pdi/ . Vcards are great for exchanging information and you’ll find them in use on everything from Mobiles to I believe some Ipods now support vcards. I’ve come up with a couple of versions of this script the first script will take a directory that contains Vcards and create a new contact for each vcard file in the directory. The other thing I’ve created is a Event sink so you can send a mail that has an attached vcard the sink will detach the vcard and create a contact within that folder from the information that’s contained in the Vcard. As I was mainly working with the Palm Desktop software this software also allowed the inclusion of a photo within the Vcard so this script also handles converting this photo into a Jpg and attaching it to the contact so it can be displayed in Outlook 2003 Contact picture section.
How does it work
To get this to work I’ve had to use multiple API’s to do each of the bits I needed. The first API that is used is CDOEX which has the ability to create a Vcard stream from a existing Oultook Contact which we can use in reverse via the ADO streams interface to create a contact from a Vcard file (pretty easy actually). That’s really the basis of the code the one thing that CDOEX cant do is understand the Photo section in the vcard stream (if one exists) so this is where some custom code is required to firstly decode the base64 MIME part turn it into a jpg file and then attach it to the contact and manipulate the correct MAPI properties.
To decode the photo MIME part CDOEX is used again but this time the Bodypart interface is used and the ADO stream interface is again used to decode the base64 MIME part and turn it back into a downloadable file. Once the Contact Picture has been downloaded and attached to the contact the EntryId for the contact is then retrieved and used in a section of CDO code which then connects to the same contact and sets some Mapi properties on the attachment itself that tell outlook that there is a contact picture for this contact. I’ve explained why MAPI is necessary and the properties that are set in this post last week. Both these scripts are setup to use public contacts folders if you want to do this in a mailbox there are a few modification that need to be made to the script which I’ll point out later
Using it with the PalmDesktop
Another script I’ve included in the download is a script that will split apart the export from the PalmDesktop software. One good feature of this software is that you have the ability to export your conacts to a VCF file. But if you select multiple contacts and do an export then all you contacts get exported to one file. To split this one export file into a separate VCF’s for each contact I’ve included a simple script that will split this out (splitvcf.vbs).
Running the Import Script
The import script has a few hard-coded variables you may need to modify before running it first
public const pfPublicContactsFolder = file://./backofficestorage/domain.com/public folders/pubcontacts/
This is the Exoledb file URI of the folder where you want to import the vcards to (note I’m using a public folder but someone’s contacts folder will work just as well)
public const vcardfolder = "c:\vcardimport"
This is the folder where the Vcards are located that you want to import make sure you only have Vcards in the folder the script doesn’t differentiate
public const mapiserver = "servername"
The in the Mailserver name this is required so the CDO section of the script can logon
public const mapimailbox = "mailbox"
This is a mailbox that exists on the same server as the public folder you’re adding the contacts to the user running the script must have permission to logon to this mailbox.
Once you have made these modifications to the script you should be ready to go
Changing the script to use a Mailbox instead of a public folder.
The main change if you are using a Mailbox instead of a public folder is after you have changed the Exoledb file URI is that you need to modify the CDO section of the code so it doesn’t use the public folder store when it goes to call getmessage eg change the following line
set objmessage = objSession.getmessage(eiEntryID,objpubstore.ID) to
set objmessage = objSession.getmessage(eiEntryID)
Using the Event Sink
The eventsink is the same as the Import script except that it’s designed to be used unattended. So it will fire and add contacts to the folder it’s registered on before registering the event sink however you need to make sure you set the following two variables.
public const mapiserver = "servername"
public const mapimailbox = "mailbox"
These need to be set to a mailbox that is on the same server as the public folder (or mailbox). You also need to make sure the account that the Exoledb.scripthost is running under has rights to logon to this mailbox. A few things to note about the event sink is that firstly it DELETES the message that was sent to it with the attached VCard. So if you want to run this in a mailbox you would need to change this also you need to change the section so it will create the contact in the desired contacts folder instead of the folder where the sink is registered. And also it only will fire on messages sent to that mail-enabled folder and not copied into the folder (this was mainly a safety mechanism to stop the dreaded never-ending sink loop)
I’ve put a download of the scripts here the event sink code looks like
<SCRIPT LANGUAGE="VBScript">
public const mapiserver = "servername"
public const mapimailbox = "mailbox"
Sub ExStoreEvents_OnSave(pEventInfo, bstrURLItem, lFlags)
on error resume next
Const EVT_NEW_ITEM = 1
Const EVT_IS_DELIVERED = 8
If (lFlags And EVT_IS_DELIVERED) Then
set objmessage = createobject("CDO.Message")
objmessage.datasource.open bstrURLItem
if objmessage.fields("DAV:contentclass").value = "urn:content-classes:message"
then
Set objAttachments = objMessage.Attachments
If objAttachments.Count <> 0 Then
For Each objAttachment In objAttachments
fatt1 = len(objAttachment.filename)
fatt2 = fatt1 - 2
attname = UCASE(objAttachment.filename)
if lcase(mid(attname,fatt2,3)) = "vcf" then
Set Strm = objAttachment.GetDecodedContentStream
call ProcVcard(Strm.readtext,objmessage.fields("DAV:parentname").value)
delmsg = 1
end if
Next
End If
End If
End if
set objmessage = nothing
if delmsg = 1 then
set rec = createobject("ADODB.Record")
rec.open bstrURLItem,,3
rec.deleterecord
set rec = nothing
end if
End Sub
sub ProcVcard(vcardstream,pfPublicContactsFolder)
pfPublicContactsFolder = pfPublicContactsFolder & "/"
cphoto = 0
set contobj1 = createobject("CDO.Person")
set stm1 = contobj1.getvcardstream()
stm1.type = 2
stm1.Charset = "x-ansi"
stm1.writetext = vcardstream
stm1.flush
vcararry = split(vcardstream,vbcrlf)
for i = lbound(vcararry) to ubound(vcararry)
if instr(vcararry(i),"PHOTO;")then
cphoto = 1
else
if cphoto = 1 then
if instr(vcararry(i)," ") then
photovcard = photovcard & vcararry(i) & vbcrlf
else
cphoto =2
end if
end if
end if
next
Randomize ' Initialize random-number generator.
rndval = Int((20000000000 * Rnd) + 1)
contname = pfPublicContactsFolder & day(now) & month(now) & year(now) & hour(now)
& minute(now) & rndval & ".eml"
contobj1.fields("urn:schemas:mailheader:subject").value = contobj1.fileas
contobj1.fields.update
if contobj1.fields("urn:schemas:mailheader:subject").value = "" then
else
contobj1.datasource.saveto contname
set contobj1 = nothing
if cphoto = 2 then
set objmessage = createobject("CDO.Message")
objmessage.datasource.open contname,,3
Set objbpart = objmessage.BodyPart.AddBodyPart
Set Flds = objbpart.Fields
Flds("urn:schemas:mailheader:content-type") = "image/jpeg"
Flds("urn:schemas:mailheader:content-disposition") = "attachment;filename=ContactPicture.jpg"
Flds("urn:schemas:mailheader:content-transfer-encoding") = "base64"
Flds.Update
set Stm = createobject("ADODB.Stream")
Set Stm = objbpart.GetEncodedContentStream
stm.type = 2
Stm.writetext photovcard
Stm.Flush
Stm.Close
Set fso = CreateObject("Scripting.FileSystemObject")
if (fso.FileExists("c:\temp\ContactPicture.jpg")) Then
fso.deletefile("c:\temp\ContactPicture.jpg")
End If
objbpart.savetofile "c:\temp\ContactPicture.jpg"
objmessage.addattachment "c:\temp\ContactPicture.jpg"
objmessage.fields("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/0x00008015")
= true
objmessage.fields("http://schemas.microsoft.com/mapi/proptag/0x0037001E") =
objmessage.fields("urn:schemas:contacts:fileas").value
objmessage.fields.update
objmessage.datasource.save
eiEntryID = Octenttohex(objmessage.fields("http://schemas.microsoft.com/mapi/proptag/0x0FFF0102").value)
set objSession = CreateObject("MAPI.Session")
Const Cdoprop1 = &H7FFF000B
const Cdoprop2 = &H370B0003
const Cdoprop3 = &HE210003
strProfile = mapiserver & vbLf & mapimailbox
objSession.Logon "",,, False,, True, strProfile
Set objInbox = objSession.Inbox
Set objInfoStore = objSession.GetInfoStore(objSession.Inbox.StoreID)
Set objpubstore = objSession.InfoStores("Public Folders")
set objmessage = objSession.getmessage(eiEntryID,objpubstore.ID)
set objAttachments = objmessage.Attachments
For Each objAttachment In objAttachments
objAttachment.fields.add Cdoprop1,"True"
objAttachment.fields(Cdoprop2).value = -1
Next
objmessage.update
end if
end if
end sub
Function Octenttohex(OctenArry)
ReDim aOut(UBound(OctenArry))
For i = 1 to UBound(OctenArry) + 1
if len(hex(ascb(midb(OctenArry,i,1)))) = 1 then
aOut(i-1) = "0" & hex(ascb(midb(OctenArry,i,1)))
else
aOut(i-1) = hex(ascb(midb(OctenArry,i,1)))
end if
Next
Octenttohex = join(aOUt,"")
End Function
</SCRIPT>
How does it work
To get this to work I’ve had to use multiple API’s to do each of the bits I needed. The first API that is used is CDOEX which has the ability to create a Vcard stream from a existing Oultook Contact which we can use in reverse via the ADO streams interface to create a contact from a Vcard file (pretty easy actually). That’s really the basis of the code the one thing that CDOEX cant do is understand the Photo section in the vcard stream (if one exists) so this is where some custom code is required to firstly decode the base64 MIME part turn it into a jpg file and then attach it to the contact and manipulate the correct MAPI properties.
To decode the photo MIME part CDOEX is used again but this time the Bodypart interface is used and the ADO stream interface is again used to decode the base64 MIME part and turn it back into a downloadable file. Once the Contact Picture has been downloaded and attached to the contact the EntryId for the contact is then retrieved and used in a section of CDO code which then connects to the same contact and sets some Mapi properties on the attachment itself that tell outlook that there is a contact picture for this contact. I’ve explained why MAPI is necessary and the properties that are set in this post last week. Both these scripts are setup to use public contacts folders if you want to do this in a mailbox there are a few modification that need to be made to the script which I’ll point out later
Using it with the PalmDesktop
Another script I’ve included in the download is a script that will split apart the export from the PalmDesktop software. One good feature of this software is that you have the ability to export your conacts to a VCF file. But if you select multiple contacts and do an export then all you contacts get exported to one file. To split this one export file into a separate VCF’s for each contact I’ve included a simple script that will split this out (splitvcf.vbs).
Running the Import Script
The import script has a few hard-coded variables you may need to modify before running it first
public const pfPublicContactsFolder = file://./backofficestorage/domain.com/public folders/pubcontacts/
This is the Exoledb file URI of the folder where you want to import the vcards to (note I’m using a public folder but someone’s contacts folder will work just as well)
public const vcardfolder = "c:\vcardimport"
This is the folder where the Vcards are located that you want to import make sure you only have Vcards in the folder the script doesn’t differentiate
public const mapiserver = "servername"
The in the Mailserver name this is required so the CDO section of the script can logon
public const mapimailbox = "mailbox"
This is a mailbox that exists on the same server as the public folder you’re adding the contacts to the user running the script must have permission to logon to this mailbox.
Once you have made these modifications to the script you should be ready to go
Changing the script to use a Mailbox instead of a public folder.
The main change if you are using a Mailbox instead of a public folder is after you have changed the Exoledb file URI is that you need to modify the CDO section of the code so it doesn’t use the public folder store when it goes to call getmessage eg change the following line
set objmessage = objSession.getmessage(eiEntryID,objpubstore.ID) to
set objmessage = objSession.getmessage(eiEntryID)
Using the Event Sink
The eventsink is the same as the Import script except that it’s designed to be used unattended. So it will fire and add contacts to the folder it’s registered on before registering the event sink however you need to make sure you set the following two variables.
public const mapiserver = "servername"
public const mapimailbox = "mailbox"
These need to be set to a mailbox that is on the same server as the public folder (or mailbox). You also need to make sure the account that the Exoledb.scripthost is running under has rights to logon to this mailbox. A few things to note about the event sink is that firstly it DELETES the message that was sent to it with the attached VCard. So if you want to run this in a mailbox you would need to change this also you need to change the section so it will create the contact in the desired contacts folder instead of the folder where the sink is registered. And also it only will fire on messages sent to that mail-enabled folder and not copied into the folder (this was mainly a safety mechanism to stop the dreaded never-ending sink loop)
I’ve put a download of the scripts here the event sink code looks like
<SCRIPT LANGUAGE="VBScript">
public const mapiserver = "servername"
public const mapimailbox = "mailbox"
Sub ExStoreEvents_OnSave(pEventInfo, bstrURLItem, lFlags)
on error resume next
Const EVT_NEW_ITEM = 1
Const EVT_IS_DELIVERED = 8
If (lFlags And EVT_IS_DELIVERED) Then
set objmessage = createobject("CDO.Message")
objmessage.datasource.open bstrURLItem
if objmessage.fields("DAV:contentclass").value = "urn:content-classes:message"
then
Set objAttachments = objMessage.Attachments
If objAttachments.Count <> 0 Then
For Each objAttachment In objAttachments
fatt1 = len(objAttachment.filename)
fatt2 = fatt1 - 2
attname = UCASE(objAttachment.filename)
if lcase(mid(attname,fatt2,3)) = "vcf" then
Set Strm = objAttachment.GetDecodedContentStream
call ProcVcard(Strm.readtext,objmessage.fields("DAV:parentname").value)
delmsg = 1
end if
Next
End If
End If
End if
set objmessage = nothing
if delmsg = 1 then
set rec = createobject("ADODB.Record")
rec.open bstrURLItem,,3
rec.deleterecord
set rec = nothing
end if
End Sub
sub ProcVcard(vcardstream,pfPublicContactsFolder)
pfPublicContactsFolder = pfPublicContactsFolder & "/"
cphoto = 0
set contobj1 = createobject("CDO.Person")
set stm1 = contobj1.getvcardstream()
stm1.type = 2
stm1.Charset = "x-ansi"
stm1.writetext = vcardstream
stm1.flush
vcararry = split(vcardstream,vbcrlf)
for i = lbound(vcararry) to ubound(vcararry)
if instr(vcararry(i),"PHOTO;")then
cphoto = 1
else
if cphoto = 1 then
if instr(vcararry(i)," ") then
photovcard = photovcard & vcararry(i) & vbcrlf
else
cphoto =2
end if
end if
end if
next
Randomize ' Initialize random-number generator.
rndval = Int((20000000000 * Rnd) + 1)
contname = pfPublicContactsFolder & day(now) & month(now) & year(now) & hour(now)
& minute(now) & rndval & ".eml"
contobj1.fields("urn:schemas:mailheader:subject").value = contobj1.fileas
contobj1.fields.update
if contobj1.fields("urn:schemas:mailheader:subject").value = "" then
else
contobj1.datasource.saveto contname
set contobj1 = nothing
if cphoto = 2 then
set objmessage = createobject("CDO.Message")
objmessage.datasource.open contname,,3
Set objbpart = objmessage.BodyPart.AddBodyPart
Set Flds = objbpart.Fields
Flds("urn:schemas:mailheader:content-type") = "image/jpeg"
Flds("urn:schemas:mailheader:content-disposition") = "attachment;filename=ContactPicture.jpg"
Flds("urn:schemas:mailheader:content-transfer-encoding") = "base64"
Flds.Update
set Stm = createobject("ADODB.Stream")
Set Stm = objbpart.GetEncodedContentStream
stm.type = 2
Stm.writetext photovcard
Stm.Flush
Stm.Close
Set fso = CreateObject("Scripting.FileSystemObject")
if (fso.FileExists("c:\temp\ContactPicture.jpg")) Then
fso.deletefile("c:\temp\ContactPicture.jpg")
End If
objbpart.savetofile "c:\temp\ContactPicture.jpg"
objmessage.addattachment "c:\temp\ContactPicture.jpg"
objmessage.fields("http://schemas.microsoft.com/mapi/id/{00062004-0000-0000-C000-000000000046}/0x00008015")
= true
objmessage.fields("http://schemas.microsoft.com/mapi/proptag/0x0037001E") =
objmessage.fields("urn:schemas:contacts:fileas").value
objmessage.fields.update
objmessage.datasource.save
eiEntryID = Octenttohex(objmessage.fields("http://schemas.microsoft.com/mapi/proptag/0x0FFF0102").value)
set objSession = CreateObject("MAPI.Session")
Const Cdoprop1 = &H7FFF000B
const Cdoprop2 = &H370B0003
const Cdoprop3 = &HE210003
strProfile = mapiserver & vbLf & mapimailbox
objSession.Logon "",,, False,, True, strProfile
Set objInbox = objSession.Inbox
Set objInfoStore = objSession.GetInfoStore(objSession.Inbox.StoreID)
Set objpubstore = objSession.InfoStores("Public Folders")
set objmessage = objSession.getmessage(eiEntryID,objpubstore.ID)
set objAttachments = objmessage.Attachments
For Each objAttachment In objAttachments
objAttachment.fields.add Cdoprop1,"True"
objAttachment.fields(Cdoprop2).value = -1
Next
objmessage.update
end if
end if
end sub
Function Octenttohex(OctenArry)
ReDim aOut(UBound(OctenArry))
For i = 1 to UBound(OctenArry) + 1
if len(hex(ascb(midb(OctenArry,i,1)))) = 1 then
aOut(i-1) = "0" & hex(ascb(midb(OctenArry,i,1)))
else
aOut(i-1) = hex(ascb(midb(OctenArry,i,1)))
end if
Next
Octenttohex = join(aOUt,"")
End Function
</SCRIPT>