How To Get and Set a Property on a Public Folder Item Using WebDAV (300185)

MORE INFORMATION

1. In Exchange 2000 Server, under All Public Folders, create a public folder and name it Folder1. In Folder1, create an item and name it Test1.
2. In Visual Basic, create a Standard EXE project. Form1 is created by default.
3. Add a command button to Form1 and name it Command1.
4. Add a reference to the Microsoft XML Object Library.
5. Paste the following code in the code section of Form1:NOTE: Change e2kServer in the code to the name of your Exchange server. Also, change the UserID and password that are mentioned in the "TO DO" comments to correspond to the appropriate user.

   Private Sub Command1_Click()
   sSourceURL = "http://e2kServer/public/Folder1/Test1.eml"
   
   sUserID = "Domain\UserID" 'TO DO Change the UserID.
   sPassword = "Password"  'TO DO Change the Password.
   sSubject = PropFind(sSourceURL, sUserID, sPassword)
   MsgBox sSubject
   
   'To change the subject, uncomment the following line.
   'PropPatch sSourceURL, "NewSubject"
   End Sub
   
   Function PropFind(ByVal sSourceURL As String, ByVal sUserID As String, ByVal sPassword As String) As String
   
   Dim sReq As String
   
   'TO use MSXML 2.0 use the following DIM/SET statements
   Dim XMLreq As XMLHTTP
   Set XMLreq = CreateObject("Microsoft.xmlhttp")
   Set oDocBack = CreateObject("MICROSOFT.XMLDOM")
      
   
   'To use MSXML 4.0 use the folloiwing DIM/SET statements 
   'Dim XMLreq As MSXML2.XMLHTTP40
   'Set XMLreq = CreateObject("Msxml2.XMLHTTP.4.0")
   'Set oDocBack = CreateObject("MSXML2.DomDocument.4.0")
   
   XMLreq.open "PROPFIND", sSourceURL, False, sUserID, sPassword
   
   'Set the header.
   XMLreq.setRequestHeader "Content-Type", "text/xml"
      
   sReq = "<?xml version='1.0'?>"
   sReq = sReq & "<d:propfind xmlns:d='DAV:' xmlns:m='urn:schemas:mailheader:'><d:prop>"
   sReq = sReq & "<m:subject/>"
   sReq = sReq & "</d:prop></d:propfind>"
   
   XMLreq.send sReq
   
   Set oDocBack = XMLreq.responseXML
   Set objNodeList = oDocBack.getElementsByTagName("d:subject")
   PropFind = objNodeList(0).Text
   
   End Function
   
   Sub PropPatch(ByVal sSourceURL As String, ByVal sNewVal As String)
   
   Dim sReq As String
   
   'TO use MSXML 2.0 use the following DIM/SET statements
   Dim XMLreq As XMLHTTP
   Set XMLreq = CreateObject("Microsoft.xmlhttp")
   
   
   'To use MSXML 4.0 use the folloiwing SET/DIM statements 
   'Dim XMLreq As MSXML2.XMLHTTP40
   'Set XMLreq = CreateObject("Msxml2.XMLHTTP.4.0")
   
   
      
   XMLreq.open "PROPPATCH", sSourceURL, False, sUserID, sPassword
   
   'Set the header.
   XMLreq.setRequestHeader "Content-Type", "text/xml"
   
   sReq = "<?xml version='1.0'?>"
   sReq = sReq & "<d:propertyupdate xmlns:d='DAV:' xmlns:m='urn:schemas:mailheader:'>"
   sReq = sReq & "<d:set><d:prop>"
   sReq = sReq & "<m:subject>" & sNewVal & "</m:subject>"
   sReq = sReq & "</d:prop></d:set></d:propertyupdate>"
    
   XMLreq.send sReq
   
   If XMLreq.Status = 207 Then
       MsgBox "Success"
   End If
   
   End Sub
   					

6. Run the project.