Howto export Microsoft Outlook contacts to XML using tcom and tDom

This page provides an example of how to export Microsoft Outlook default contact folder to XML using the registry, tcom and tDom package. For some more information see: How one discovers the API for a COM-exporting application and Microsoft OLE/COM Date.
Alexander Schöpe
Export Microsoft Outlook default contact folder to XML:

 #
 # Outlook Contact Export to XML using tcom and tdom Libraries
 #
 # (c) 2007 Alexander Schoepe $Id: outlook_export_xml.tcl,v 1.1 2007/09/15 20:34:47 alex Exp $
 #
 # This Software Snippet is distributed in the hope that it will be
 # useful, but WITHOUT ANY WARRANTY; without even the implied warranty
 # of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 #
 # http://msdn2.microsoft.com/en-us/library/aa219371(office.11).aspx
 #

 package require registry
 package require tcom
 package require tdom

 array set opts {
   application Outlook.Application
   date %Y-%m-%d
   datetime %Y-%m-%dT%H:%M:%S
   invalidDate 949998.0
   xml contacts.xml 
 }

 proc COleToCTime float {
   return [expr {round(($float - 25569) * 86400)}]
 }

 if {[catch {registry get HKEY_CLASSES_ROOT\\$opts(application)\\CLSID {}} clsid]} {
   puts stderr "registry: $clsid"
   exit 1
 }
 if {[catch {registry get HKEY_CLASSES_ROOT\\CLSID\\$clsid\\Typelib {}} typelib]} {
   puts stderr "registry: $typelib"
   exit 1
 }
 if {[catch {registry keys HKEY_CLASSES_ROOT\\TypeLib\\$typelib} keys]} {
   puts stderr "registry: $keys"
   exit 1
 }
 set version [lindex [lsort -real $keys] end]
 if {[catch {registry get HKEY_CLASSES_ROOT\\Typelib\\$typelib\\$version\\FLAGS {}} flag]} {
   puts stderr "registry: $flag"
   exit 1
 }
 if {[catch {registry get HKEY_CLASSES_ROOT\\Typelib\\$typelib\\$version\\$flag\\win32 {}} win32]} {
   puts stderr "registry: $win32"
   exit 1
 }
 if {[catch {::tcom::import $win32} olb]} {
   puts stderr "tcom: $olb"
   exit 1
 } 
 unset clsid typelib keys flag win32
  
 foreach varname {OlDefaultFolders OlInspectorClose} {
   upvar #0 ${olb}::$varname $varname
 }

 foreach varname {MailingAddress Gender Sensitivity Importance} {
   switch -- $varname {
     Importance { set pos 12 }
     default { set pos 2 }
   }
   upvar #0 ${olb}::Ol$varname source
   upvar #0 $varname destination
   foreach {name value} [array get source] {
     set destination($value) [string range $name $pos end]
   }
 }
 array set SelectedMailingAddress [array get MailingAddress]
 array unset MailingAddress

 if {[catch {::tcom::ref createobject $opts(application)} application]} {
   puts stderr "tcom: $application"
   exit 1
 }
 set session [$application Session]

 set start [clock seconds]

 set doc [dom createDocument contacts]
 set root [$doc documentElement]
 $root setAttribute version 1.0

 set node [$doc createElement name]
 $node appendChild [$doc createTextNode "$opts(application) Export"]
 $root appendChild $node

 set properties [$doc createElement properties]
 $root appendChild $properties

 set node [$doc createElement time]
 $node appendChild [$doc createTextNode [clock format [clock seconds] -format $opts(datetime)]]
 $root appendChild $node

 set folder [$session GetDefaultFolder $OlDefaultFolders(olFolderContacts)]
 set items [$folder Items]
 set count [$items Count]

 puts "exporting $count contacts"

 for {set index 1} {$index <= $count} {incr index} {
   set item [$items Item $index]
   set itemProp [$item ItemProperties]

   set contact [$doc createElement contact]
   $contact setAttribute index $index
   $root appendChild $contact

   set ipc [$itemProp Count]
   for {set i 0} {$i < $ipc} {incr i} {
     set prop [$itemProp Item $i]
     set name [$prop Name]
     set data [$prop Value]

     set node {}

     if {[string trim $data] != "" && ![string match ::tcom::handle0x* $data]} {
       set fmt {}
       switch -- $name {
         AutoResolvedWinner -
         Class -
         ConversationIndex -
         DownloadState -
         Email1AddressType -
         Email1EntryID -
         Email2AddressType -
         Email2EntryID -
         Email3AddressType -
         Email3EntryID -
         IsConflict -
         Journal -
         MailingAddress -
         MailingAddressCity -
         MailingAddressCountry -
         MailingAddressPostOfficeBox -
         MailingAddressPostalCode -
         MailingAddressState -
         MailingAddressStreet -
         MarkForDownload -
         Saved -
         Size -
         UnRead {
         }
         Birthday -
         Anniversary {
           if {$data != $opts(invalidDate)} {
             set node [$doc createElement $name]
             if {![catch {clock format [COleToCTime $data] -format $opts(date)} fmtData]} {
               $node setAttribute float $data
               $node appendChild [$doc createTextNode $fmtData]
             } else {
               $node appendChild [$doc createTextNode $data]
             }
           }
         }
         CreationTime -
         LastModificationTime {
           set node [$doc createElement $name]
           if {![catch {clock format [COleToCTime $data] -format $opts(datetime)} fmtData]} {
             $node setAttribute float $data
             $node appendChild [$doc createTextNode $fmtData]
           } else {
             $node appendChild [$doc createTextNode $data]
           }
         }
         Gender -
         Importance -
         SelectedMailingAddress -
         Sensitivity {
           upvar #0 $name enum
           set node [$doc createElement $name]
           if {[info exists enum($data)]} {
             $node setAttribute integer $data
             $node appendChild [$doc createTextNode $enum($data)]
           } else {
             $node appendChild [$doc createTextNode $data]
           }
         }
         default {
           set node [$doc createElement $name]
           $node appendChild [$doc createTextNode $data]
         }
       }
       if {$node != ""} {
         $contact appendChild $node
         set property($name) {}
       }
     }
   }
   $item Close $OlInspectorClose(olDiscard)
 }

 set node [$doc createElement contacts]
 $node setAttribute count $count
 $node setAttribute seconds [expr {[clock seconds] - $start}]
 $node appendChild [$doc createTextNode [lsort [array names property]]]
 $properties appendChild $node

 if {[catch {open $opts(xml) w} fd]} {
   puts stderr "xml: $fd"
 } else {
   puts $fd [$root asXML]
   close $fd
   puts "saved to file $opts(xml)"
 }
Category Example
Category Package
Category Windows
Category XML