HOWTO: VB - Reading Delegates WebDAV Sample

  • Article

Private Sub Command1_Click()
    '=====================================================
    'DoXML takes the href to a document
    'and returns the MAPI PR_ENTRYID property expressed in
    'a hexadecimal string format such as is used by CDO 1.21
    'Function DoXML(strHref)
    Dim objX
    Dim objXMLdoc
    Dim objNode
    Dim strR As String
    Dim retXML As String
   
    Dim parseStringtemp As String
    Dim parseString As String
   
    strHref = "<<Error! Hyperlink reference not valid.> folders/public folder/subject.eml>"  '<<https://servername/exchange/mailboxname/>>
    Set objX = CreateObject("MSXML2.ServerXMLHTTP")
   

    strR = "<?xml version='1.0'?><d:propfind xmlns:d='DAV:' xmlns:m='https://schemas.microsoft.com/mapi/'>"
    strR = strR & "<d:prop><m:dlmembers/></d:prop></d:propfind>"

    retXML = DoPropFind(strHref, "<Domain\Username>", "<password>", strR)
   
    ' This won't work since we can load "Datatype 'mv.bin.base64'" into the DOM.
    'objXMLdoc.setProperty "SelectionNamespaces", "xmlns:d='https://schemas.microsoft.com/mapi/'"
    'Set objNode = objXMLdoc.selectSingleNode("/d:dlmembers")
    'MsgBox objNode.Text
   
    parseStringtemp = Right(retXML, InStr(1, retXML, "<c:v>"))
    parseString = Left(parseStringtemp, (Len(parseStringtemp) - (InStrRev(parseStringtemp, "<c:v>"))))

    ' Insert your generic decoding code here:
    'DoXML = BinToHex(Decode64(parseString))
    DoXML = Decode64(parseString)

    MsgBox DoXML
   
   
    'End Function
End Sub

'--------------------------------------------------------------
' DoPropFind
'   Searches an HREF for content.
' Input
'   sType - "SEARCH", "PROPFIND", etc
'   sQuery - Search to perform (XML query document)
'   sHREF - Http reference to item(s)/folder
'   sUserName - Domain/Username for server
'   sPassword - Password for the account above
' Returns: An XML document resulting from the search
'--------------------------------------------------------------
Public Function DoPropFind(ByVal sHREF As String, ByVal sUserName As String, ByVal sPassword As String, sQuery As String)  As String
    Dim HttpWebRequest As MSXML2.XMLHTTP30
    Set HttpWebRequest = New MSXML2.XMLHTTP30
   
    'TO use MSXML 2.0 use the following DIM/SET statements
    'Dim HttpWebRequest As XMLHTTP
    'Set HttpWebRequest = CreateObject("Microsoft.xmlhttp")
      
    'To use MSXML 4.0 use the folloiwing DIM/SET statements
    'Dim HttpWebRequest As MSXML2.XMLHTTP40
    'Set HttpWebRequest = CreateObject("Msxml2.XMLHTTP.4.0")

    Dim sText As String
    ' Open the folder
    HttpWebRequest.Open "PROPFIND", sHREF, False, sUserName, sPassword
   
    ' Set up request headers
    HttpWebRequest.setRequestHeader "Content-Type", "text/xml"

    ' Send the query
    HttpWebRequest.send (sQuery)

    Debug.Print HttpWebRequest.Status
    Debug.Print HttpWebRequest.statusText
    Debug.Print HttpWebRequest.responseText
   
    sText = HttpWebRequest.responseText
   
    Set HttpWebRequest = Nothing

    DoPropFind = sText
End Function