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

   Set oDoc = CreateObject("MICROSOFT.XMLDOM")
   Set oDocBack = CreateObject("MICROSOFT.XMLDOM")
   
   MSXML 4.0 
   Dim oDoc As MSXML2.DOMDocument40
   Dim oDocBack As MSXML2.DOMDocument40
   Dim req As MSXML2.XMLHTTP40
   Set oDoc = CreateObject("MSXML2.DomDocument.4.0")
   Set oDocBack = CreateObject("MSXML2.DomDocument.4.0")
   
   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