Tuesday, January 04, 2005

Copying email from the Inbox to eml files on the file system

Somebody asked how to copy email from a mailbox or public folder to the file system using WebDAV. One way of doing this is to grab the email as stream using a WebDAV get as illustrated in the Exchange SDK here
Once you have the email as a stream you can then use an ADO stream object's savetofile method to save it as an eml file. If you combine that with a webdav search you can then select all the emails in a certain folder and export this to a folder on the file system. The following example exports all the mail in a inbox to a folder on the c: drive called exp. I've posted a downloadable copy of this code here.

server = "servername"
mailbox = "mailbox"
set fso = createobject("Scripting.FileSystemObject")
strURL = "http://" & server & "/exchange/" & mailbox & "/inbox/"
strURL1 = "http://" & server & "/exchange/" & mailbox & "/sent items/"
strQuery = ""
strQuery = strQuery & "SELECT ""DAV:displayname"", ""urn:schemas:httpmail:subject"""
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & strURL & """') Where ""DAV:ishidden"" = False AND ""DAV:isfolder"" = False AND "
strQuery = strQuery & """DAV:contentclass"" = 'urn:content-classes:message'
set req = createobject("microsoft.xmlhttp")
req.open "SEARCH", strURL, false
req.setrequestheader "Content-Type", "text/xml"
rem req.setrequestheader "Range", "rows=0-100"
req.setRequestHeader "Translate","f"
req.send strQuery
If req.status >= 500 Then
ElseIf req.status = 207 Then
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("a:displayname")
set oNodeList1 = oResponseDoc.getElementsByTagName("a:href")
For i = 0 To (oNodeList.length -1)
set oNode = oNodeList.nextNode
set oNode1 = oNodeList1.nextNode
df = expmail(oNode.Text,oNode1.text)
End If

function expmail(displayname,href)
req.open "GET", href, false
req.setRequestHeader "Translate","f"
fname = replace(replace(replace(replace(replace(displayname,":","-"),"\",""),"/",""),"?",""),chr(34),"")
fname = replace(replace(replace(replace(replace(replace(fname,"<",""),">",""),chr(11),""),"*",""),"|",""),"(","")
fname = replace(replace(replace(fname,")",""),chr(12),""),chr(15),"")
fname = "c:\exp\" & fname
wscript.echo fname
set stm = createobject("ADODB.Stream")
msgstring = req.responsetext
stm.type = 2
stm.Charset = "x-ansi"
stm.writetext msgstring,0
stm.Position = 0
stm.type = 1
stm.savetofile fname
set stm = nothing

end function