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