backup outlook tasks

[vonClausowitz]

Hi All,

I would like to make a backup of my outlook tasks without using the
export as .pst.
I just want a VBA macro that will make a copy of all my outlook tasks
as xml data or to a format
like access or so.

Marco

 

[Guest]

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