Mailbox Access via HTTP/WebDAV

Mailbox Access via HTTP/WebDAV

This VBScript sample demonstrates how to read inbox messages from Exchange 2000 using the WebDAV SEARCH method and the XMLHTTP COM object.

Read Inbox Messages

' Exchange WebDAV Inbox Reader
' Retrieves the 10 most recent messages from a user's inbox

Dim strServer, strUser, strPassword, strMailbox
strServer   = "mail.corp.flamenet.io"
strUser     = "CORP\jsmith"
strPassword = "P@ssw0rd!"
strMailbox  = "jsmith"

Dim strURL
strURL = "http://" & strServer & "/exchange/" & strMailbox & "/Inbox/"

Dim strQuery
strQuery = "" & vbCrLf & _
    "" & vbCrLf & _
    "  " & vbCrLf & _
    "    SELECT ""urn:schemas:httpmail:subject""," & vbCrLf & _
    "           ""urn:schemas:httpmail:fromemail""," & vbCrLf & _
    "           ""urn:schemas:httpmail:datereceived""" & vbCrLf & _
    "    FROM SCOPE('SHALLOW TRAVERSAL OF """ & strURL & """')" & vbCrLf & _
    "    WHERE ""DAV:ishidden"" = false" & vbCrLf & _
    "      AND ""DAV:isfolder"" = false" & vbCrLf & _
    "    ORDER BY ""urn:schemas:httpmail:datereceived"" DESC" & vbCrLf & _
    "  " & vbCrLf & _
    ""

Dim objHTTP
Set objHTTP = CreateObject("Microsoft.XMLHTTP")
objHTTP.Open "SEARCH", strURL, False, strUser, strPassword
objHTTP.setRequestHeader "Content-Type", "text/xml"
objHTTP.setRequestHeader "Depth", "1"
objHTTP.Send strQuery

If objHTTP.Status = 207 Then
    Dim objDoc
    Set objDoc = CreateObject("MSXML2.DOMDocument")
    objDoc.loadXML objHTTP.responseText
    objDoc.setProperty "SelectionNamespaces", _
        "xmlns:d='DAV:' xmlns:m='urn:schemas:httpmail:'"

    Dim objNodes
    Set objNodes = objDoc.selectNodes("//d:response")

    WScript.Echo "Found " & objNodes.length & " messages:"
    WScript.Echo String(60, "-")

    Dim i
    For i = 0 To objNodes.length - 1
        Dim strSubject, strFrom, strDate
        strSubject = objNodes(i).selectSingleNode(".//m:subject").text
        strFrom    = objNodes(i).selectSingleNode(".//m:fromemail").text
        strDate    = objNodes(i).selectSingleNode(".//m:datereceived").text
        WScript.Echo strDate & "  " & strFrom
        WScript.Echo "  Subject: " & strSubject
        WScript.Echo ""
    Next
Else
    WScript.Echo "Error: HTTP " & objHTTP.Status & " - " & objHTTP.statusText
End If

Send an Email via WebDAV PUT

' Send an email by creating a message in the ##DavMailSubmissionURI## folder
Dim strSendURL
strSendURL = "http://" & strServer & "/exchange/" & strMailbox & _
    "/##DavMailSubmissionURI##/newmessage.eml"

Dim strMessage
strMessage = "From: jsmith@corp.flamenet.io" & vbCrLf & _
    "To: jdoe@corp.flamenet.io" & vbCrLf & _
    "Subject: Test from WebDAV" & vbCrLf & _
    "Content-Type: text/plain" & vbCrLf & vbCrLf & _
    "This message was sent using WebDAV PUT."

Set objHTTP = CreateObject("Microsoft.XMLHTTP")
objHTTP.Open "PUT", strSendURL, False, strUser, strPassword
objHTTP.setRequestHeader "Content-Type", "message/rfc822"
objHTTP.Send strMessage

If objHTTP.Status = 201 Then
    WScript.Echo "Message sent successfully."
Else
    WScript.Echo "Error: " & objHTTP.Status & " " & objHTTP.statusText
End If