Skip to content

Instantly share code, notes, and snippets.

@john-clark
Created February 24, 2017 16:59
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save john-clark/5dc8f3491ff72a48b190db6450457dcd to your computer and use it in GitHub Desktop.
Save john-clark/5dc8f3491ff72a48b190db6450457dcd to your computer and use it in GitHub Desktop.
Export Outlook Contacts to Cisco Jabber XML file
<html>
<head>
<title>OutlookContacts2CiscoJabberXML.hta</title>
<hta:application scroll="no" windowState="normal">
</head>
<script language="VBScript">
sub Window_onLoad()
Window.resizeTo 550, 850
crlf = chr(13) & chr(10)
olFolderContacts = 10
Set objShell = CreateObject("WScript.Shell")
oFolder = objShell.expandenvironmentstrings("%userprofile%") & "\Desktop\"
set oFSO=CreateObject("Scripting.FileSystemObject")
set oFile=oFSO.CreateTextFile(oFolder & "contacts.xml",2)
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set colContacts = objNamespace.GetDefaultFolder(olFolderContacts).Items
xmlOutput = "<?xml version=""1.0"" encoding=""utf-8""?>" & crlf
xmlOutput = xmlOutput & "<buddylist>" & crlf
xmlOutput = xmlOutput & " <group>" & crlf
xmlOutput = xmlOutput & " <gname>Imported</gname>" & crlf
On Error Resume Next
For Each objContact In colContacts
If InStr(objContact.Email1Address, "@") > 0 Then
xmlOutput = xmlOutput & " <user>" & crlf
xmlOutput = xmlOutput & " <uname>" & objContact.Email1Address & "</uname>" & crlf
if Len(objContact.FullName) > 0 then
xmlOutput = xmlOutput & " <fname>" & objContact.FullName & "</fname>" & crlf
else
xmlOutput = xmlOutput & " <fname>" & objContact.FirstName & " " & objContact.FirstName &"</fname>" & crlf
end if
if Len(objContact.BusinessTelephoneNumber) > 0 then
xmlOutput = xmlOutput & " <phoneNumber>" & objContact.BusinessTelephoneNumber & "</phoneNumber>" & crlf
else
xmlOutput = xmlOutput & " <phoneNumber>" & objContact.MobileTelephoneNumber & "</phoneNumber>" & crlf
end if
xmlOutput = xmlOutput & " </user>" & crlf
End If
Next
xmlOutput = xmlOutput & " </group>" & crlf
xmlOutput = xmlOutput & "</buddylist>" & crlf
document.all.xmlTextArea.value=xmlOutput
oFile.writeline xmlOutput
oFile.Close
end sub
</script>
<body>
<textarea name="xmlTextArea" rows=48 cols=60></textarea><p>
</body>
</html>
@haggar30
Copy link

haggar30 commented Jan 30, 2018

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment