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)"
 }