How To List Public Folders by Using WebDAV

Private Sub Command1_Click()
   Dim strURL As String
   Dim sUserID As String
   Dim sPassword As String
   strURL = "http://e2KServer/public/"
   sUserID = "UserID" 'TODO 
   sPassword = "password" 'TODO
   ListFolders strURL, sUserID, sPassword
End Sub

Sub ListFolders(ByVal strURL As String, ByVal sUserID As String, _
ByVal sPassword As String)
   'Dim oDoc As MSXML.DOMDocument
   'Dim oDocBack As MSXML.DOMDocument

   'Dim oNode As IXMLDOMElement
   'Dim oNode2  As IXMLDOMElement
   'Dim req As MSXML.XMLHTTPRequest

   MSXML 6.0 
   Dim oDoc As MSXML2.DOMDocument460
   Dim oDocBack As MSXML2.DOMDocument640
   Dim req As MSXML2.XMLHTTP60
   Set oDoc = CreateObject("MSXML2.DomDocument.6.0")
   Set oDocBack = CreateObject("MSXML2.DomDocument.6.0")

   Set oDoc = CreateObject("MICROSOFT.XMLDOM")
   Set oDocBack = CreateObject("MICROSOFT.XMLDOM")
   Set pi = oDoc.createProcessingInstruction("xml", "version=""1.0""")
   oDoc.appendChild pi

   Set oNode = oDoc.createNode(1, "searchrequest", "DAV:")
   Set oDoc.documentElement = oNode

   Set oNode2 = oDoc.createNode(1, "sql", "DAV:")
   oNode.appendChild oNode2
   strQuery = "Select ""DAV:displayname"" From "
   strQuery = strQuery & "Scope('Shallow Traversal of """ & strURL & """')"
   Set query = oDoc.createTextNode(strQuery)
   oNode2.appendChild query

   Set req = CreateObject("microsoft.xmlhttp")
   req.open "SEARCH", strURL, False, sUserID, sPassword
   req.setRequestHeader "Translate", "f"
   req.setRequestHeader "Content-Type", "text/xml"
   req.setRequestHeader "Depth", "0"
   req.send oDoc

   Set oDocBack = req.responseXML

   Dim objNodeList

   'Typically the DAV namespace get the 'a' prefix.
   'If you are specifying multiple properties in a search, examine the 
   'returned XML beforehand to determine prefixes for your code.

   Set objNodeList = oDocBack.getElementsByTagName("a:displayname")
   For i = 0 To (objNodeList.length - 1)
     Set objNode = objNodeList.nextNode
     Debug.Print objNode.Text
   Next
End Sub