Here's some code that outputs e-mails to XML; this can be quickly modified
for Task items:
Sub CopyEmailsToXml()
Dim dirLocation As String
dirLocation = InputBox("Please enter an absolute directory location and
filename (e.g., c:\temp\myContacts.xml). The exported XML file will be
written to this location.")
If dirLocation = Null Or Len(dirLocation) = 0 Then
Exit Sub
End If
Dim xmlDoc As DOMDocument
Dim xmlNode As IXMLDOMNode
Dim xmlEmails As IXMLDOMNode
Dim xmlPi As IXMLDOMProcessingInstruction
Set xmlDoc = New DOMDocument
Set xmlPi = xmlDoc.createProcessingInstruction("xml", "version=""1.0""")
Set xmlNode = xmlDoc.appendChild(xmlPi)
Set xmlEmails = xmlDoc.createElement("emails")
Set xmlNode = xmlDoc.appendChild(xmlEmails)
Dim objApplication As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objEmails As Outlook.MAPIFolder
Dim objEmail As Outlook.MailItem
Dim emailIndex As Integer
Set objApplication = CreateObject("Outlook.Application")
Set objNameSpace = objApplication.GetNamespace("MAPI")
Set objEmails = objNameSpace.PickFolder
' Todo: Add code to check to see if objEmails is valid
Dim xmlEmail As IXMLDOMNode
Dim xmlText As IXMLDOMText
For emailIndex = 1 To objEmails.Items.Count
Set objEmail = objEmails.Items.Item(emailIndex)
Set xmlEmail = xmlDoc.createElement("email")
Set xmlNode = xmlDoc.createElement("sender")
Set xmlText =
xmlNode.appendChild(xmlDoc.createTextNode(objEmail.SenderName))
Set xmlNode = xmlEmail.appendChild(xmlNode)
Set xmlNode = xmlDoc.createElement("receivedtime")
Set xmlText =
xmlNode.appendChild(xmlDoc.createTextNode(objEmail.ReceivedTime))
Set xmlNode = xmlEmail.appendChild(xmlNode)
Set xmlNode = xmlDoc.createElement("subject")
Set xmlText =
xmlNode.appendChild(xmlDoc.createTextNode(objEmail.Subject))
Set xmlNode = xmlEmail.appendChild(xmlNode)
Set xmlNode = xmlDoc.createElement("message")
Set xmlText =
xmlNode.appendChild(xmlDoc.createTextNode(objEmail.Body))
Set xmlNode = xmlEmail.appendChild(xmlNode)
Set xmlNode = xmlDoc.createElement("htmlmessage")
Set xmlText =
xmlNode.appendChild(xmlDoc.createTextNode(objEmail.HTMLBody))
Set xmlNode = xmlEmail.appendChild(xmlNode)
Set xmlEmail = xmlEmails.appendChild(xmlEmail)
Next
xmlDoc.Save (dirLocation)
MsgBox "Outlook E-Mail Items exported to XML"
End Sub
