Microsoft Knowledge Base Email Alertz
All KB/RSS Links  |  Hot Kb!  |  New Kb!  |  Scott Cate  |  FAQ / KB  |  Web Hosting  |  Unsubscribe  

This article demonstrates how to use WebDAV's PROPFIND and PUT methods to send an e-mail message from Visual Basic.

Search KbAlertz

Advanced Search

Receive Microsoft Knowledge Base articles by E-Mail?

Every night we scan the Microsoft Knowledge Base. If technologies you're interested in are updated, we'll send you an e-mail. You only get one e-mail a day, and only when new articles are added.
Click here to create a
FREE account
Already have an account?
[Click here to Login]











Microsoft Knowledge Base Article

This article contents is Microsoft Copyrighted material.
©2005-©2007 Microsoft Corporation. All rights reserved. Terms of Use | Trademarks
Article ID: 296713 - Last Review: October 18, 2009 - Revision: 4.0

How To Send a Message from Visual Basic by Using WebDAV

View products that this article applies to.
This article was previously published under Q296713

SUMMARY

This article demonstrates how to use WebDAV's PROPFIND and PUT methods to send an e-mail message from Visual Basic.

MORE INFORMATION

E-mail messages can be sent by using a special Uniform Resource Identifier (URI) that is called the Exchange mail submission URI. A user's mail submission URI is found by using WebDAV PROPFIND method to retrieve the value of the urn:schemas:httpmail:sendmsg property of the user's private mailbox folder. The WebDAV PUT method can then be used to put a message stream into this mail submission URI.

To use WebDAV to send a message from Visual Basic, follow these steps:
  1. In Visual Basic, create a new Standard EXE project.
  2. Add a button to the default form and name it Command1.
  3. Paste the following code into the view code window:
      Private Sub Command1_Click()
      Dim strSubURL As String
      Dim strAlias As String
      Dim strUserName As String
      Dim strPassWord As String
      Dim strExchSvrName As String
      Dim strFrom As String
      Dim strTo As String
      Dim strSubject As String
      Dim strBody As String
      Dim bResult As Boolean
      
      ' Exchange Server Name.
      strExchSvrName = "ExchangeServerName"
      ' Alias of the sender.
      strAlias = "user1"
      ' User Name of the sender.
      strUserName = "DomainName\user1"
      ' Password of the sender.
      strPassWord = "password"
      ' Email address of the sender.
      strFrom = "user1@somewhere.com"
      ' Email address of recipient.
      strTo = "user2@somewhere.com"
      ' Subject of the mail.
      strSubject = "Mail Subject"
      ' Text body of the mail.
      strBody = "Mail Body"
      
      strSubURL = FindSubmissionURL(strExchSvrName, _
               strAlias, _
               strUserName, _
               strPassWord)
               
      If strSubURL <> "" Then
         bResult = False
         bResult = SendMail(strSubURL, _
                  strFrom, _
                  strTo, _
                  strSubject, _
                  strBody, _
                  strUserName, _
                  strPassWord)
         If bResult Then
            MsgBox "Successfully send mail via WebDAV!"
         End If
      End If

   End Sub

   Function FindSubmissionURL(strExchSvr, _
          strAlias, _
          strUserName, _
          strPassWord) As String
      
       Dim query As String
     Dim strURL As String
     Dim xmlRoot As IXMLDOMElement
     Dim xmlNode As IXMLDOMNode
     Dim baseName As String

   'To use MSXML 2.0 use the following Dim statements   
      Dim xmlReq As MSXML.XMLHTTPRequest
      Dim xmldom As MSXML.DOMDocument
      Dim xmlAttr As MSXML.IXMLDOMAttribute
    
   'To use MSXML 6.0 use the following Dim statements 
      'Dim xmlReq As MSXML2.XMLHTTP40
      'Dim xmldom As MSXML2.DOMDocument60
      'Dim xmlAttr As MSXML2.IXMLDOMAttribute
      

      'namespacemanager.declarePrefix "d", "urn:schemas:httpmail:"
      'On Error GoTo ErrHandler
      ' Create the DAV PROPFIND request.

      Set xmlReq = CreateObject("Microsoft.XMLHTTP")

   'To use MSXML 6.0 use the following set statement
   '   Set xmlReq = CreateObject("Msxml2.XMLHTTP.6.0")

      strURL = "http:/" & strExchSvr & "/exchange" & strAlias
      
      xmlReq.Open "PROPFIND", strURL, False, strUserName, strPassWord
      xmlReq.setRequestHeader "Content-Type", "text/xml"
      xmlReq.setRequestHeader "Depth", "0"

      query = "<?xml version='1.0'?>"
      query = query + "<a:propfind xmlns:a='DAV:'>"
      query = query + "<a:prop xmlns:m='urn:schemas:httpmail:'>"
      query = query + "<m:sendmsg/>"
      query = query + "</a:prop>"
      query = query + "</a:propfind>"
      
      xmlReq.send (query)
    
     MsgBox xmlReq.Status
      ' process the result
      If (xmlReq.Status >= 200 And xmlReq.Status < 300) Then
        ' MsgBox "Success! " & "PROPFIND Results = " & xmlReq.Status & _
          '     ": " & xmlReq.statusText
            
         Set xmldom = xmlReq.responseXML
            
         Set xmlRoot = xmldom.documentElement  '.documentElement
       'To use MSXML 2.0 use the following code to get the Submission URL 
         For Each xmlAttr In xmlRoot.Attributes
            If xmlAttr.Text = "urn:schemas:httpmail:" Then
               baseName = xmlAttr.baseName
               Exit For
            End If
         Next
         
         Set xmlNode = xmlRoot.selectSingleNode("/" & baseName & ":sendmsg")
         FindSubmissionURL = xmlNode.Text
      
        ' To use MSXML 6.0 use the following lines of code to get the Submission URL 
        ' Dim objNodeList As IXMLDOMNodeList
        ' Set objNodeList = xmlRoot.getElementsByTagName("d:sendmsg")
        ' For i = 0 To (objNodeList.length - 1)
        '   FindSubmissionURL = objNodeList.Item(i).Text
        ' Next
      Else
         MsgBox "Failed to find mail submission URL"
         FindSubmissionURL = ""
      End If

   ErrExit:
      Set xmlReq = Nothing
      Set xmldom = Nothing
      Set xmlRoot = Nothing
      Set xmlNode = Nothing
      Set xmlAttr = Nothing
      Exit Function
   ErrHandler:
      MsgBox Err.Number & ": " & Err.Description
      FindSubmissionURL = ""
   End Function

   'Also change the function... 

   'Function SendMail(strSubURL, _
         'strFrom, _
         'strTo, _
         'strSubject, _
         'strBody, _
         'strUserName, _
         'strPassWord) As Boolean

   '...to the following to accommodate the comments for its use with MSXML 6.0: 

'   Function SendMail(strSubURL, _
'         strFrom, _
'         strTo, _
'         strSubject, _
'         strBody, _
'         strUserName, _
'         strPassWord) As Boolean
         
'        Dim strText

'        Dim xmlReq As MSXML.XMLHTTPRequest
'        Set xmlReq = CreateObject("Microsoft.XMLHTTP")

        ' To use MSXML 6.0 use the followinf DIM/SET statements
        ' Dim xmlReq As MSXML2.XMLHTTP60
        ' Set xmlReq = CreateObject("Msxml2.XMLHTTP.6.0")
      
        ' On Error GoTo ErrHandler
        ' Construct the text of the PUT request
'         strText = "From: " & strFrom & vbNewLine & _
'            "To: " & strTo & vbNewLine & _
'            "Subject: " & strSubject & vbNewLine & _
'            "Date: " & Now & _
'            "X-Mailer: test mailer" & vbNewLine & _
'            "MIME-Version: 1.0" & vbNewLine & _
'            "Content-Type: text/plain;" & vbNewLine & _
'            "Charset = ""iso-8859-1""" & vbNewLine & _
'            "Content-Transfer-Encoding: 7bit" & vbNewLine & _
'            vbNewLine & _
'            strBody
            
         ' Create the DAV PUT request.

'         xmlReq.Open "PUT", strSubURL, False, strUserName, strPassWord
'         If strText <> "" Then
'            xmlReq.setRequestHeader "Content-Type", "message/rfc822"
'            xmlReq.send strText
'         End If
         
         'Process the results.
'         If (xmlReq.Status >= 200 And xmlReq.Status < 300) Then
           ' MsgBox "Success!   " & "PUT Results = " & xmlReq.Status & _
           '    ": " & xmlReq.statusText
'            SendMail = True
'         ElseIf xmlReq.Status = 401 Then
          '  MsgBox "You don't have permission to do the job! " & _
          '     "Please check your permissions on this item."
'            SendMail = False
'         Else
          '  MsgBox "Request Failed.  Results = " & xmlReq.Status & _
            '   ": " & objRequest.statusText
'            SendMail = False
'         End If
'   ErrExit:
'      Set xmlReq = Nothing
'      Exit Function
'   ErrHandler:
'      MsgBox Err.Number & ": " & Err.Description
'      SendMail = False
'   End Function

   Function SendMail(strSubURL, _
         strFrom, _
         strTo, _
         strSubject, _
         strBody, _
         strUserName, _
         strPassWord) As Boolean
         
         'To use MSXML 2.0 use the following Dim statements
         Dim xmlReq As MSXML.XMLHTTPRequest
         'To use MSXML 6.0 use the following Dim statements
         'Dim xmlReq As MSXML2.XMLHTTP60
         Dim strText
      
         On Error GoTo ErrHandler
         ' Construct the text of the PUT request.
         strText = "From: " & strFrom & vbNewLine & _
            "To: " & strTo & vbNewLine & _
            "Subject: " & strSubject & vbNewLine & _
            "Date: " & Now & _
            "X-Mailer: test mailer" & vbNewLine & _
            "MIME-Version: 1.0" & vbNewLine & _
            "Content-Type: text/plain;" & vbNewLine & _
            "Charset = ""iso-8859-1""" & vbNewLine & _
            "Content-Transfer-Encoding: 7bit" & vbNewLine & _
            vbNewLine & _
            strBody
            
         ' Create the DAV PUT request.
         Set xmlReq = CreateObject("Microsoft.XMLHTTP")
         xmlReq.Open "PUT", strSubURL, False, strUserName, strPassWord
         If strText <> "" Then
            xmlReq.setRequestHeader "Content-Type", "message/rfc822"
            xmlReq.send strText
         End If
         
         'Process the results.
         If (xmlReq.Status >= 200 And xmlReq.Status < 300) Then
            MsgBox "Success!   " & "PUT Results = " & xmlReq.Status & _
               ": " & xmlReq.statusText
            SendMail = True
         ElseIf xmlReq.Status = 401 Then
            MsgBox "You don't have permission to do the job! " & _
               "Please check your permissions on this item."
            SendMail = False
         Else
            MsgBox "Request Failed.  Results = " & xmlReq.Status & _
               ": " & objRequest.statusText
            SendMail = False
         End If
   ErrExit:
      Set xmlReq = Nothing
      Exit Function
   ErrHandler:
      MsgBox Err.Number & ": " & Err.Description
      SendMail = False
   End Function
  4. In the code, change strExchSvrName, strAlias, strUserName, strPassWord, strFrom, and strTo according to your situation.
  5. Add a reference to the Microsoft XML version 6.0 Library.
  6. Run the program and click the button.
  7. Verify that the email message has been sent and received.
APPLIES TO
  • Microsoft Exchange 2000 Server Standard Edition
  • Microsoft XML Parser 2.0
  • Microsoft XML Core Services 6.0
  • Microsoft Visual Basic Enterprise Edition for Windows 6.0
  • Microsoft Visual Basic 6.0 Professional Edition
Back to the top
Keywords: 
kbhowto kbmsg KB296713
        

Community Feedback System

Very often, it takes hours to solve a problem. Very often, you've looked high and low, and have tried a lot of solutions. When you finally found it, chances are, it was because someone else helped you. Here's your chance to give back. Use our community feedback tool to let others know what worked for you and what didn't.

Please also understand that the community feedback system is not warranted to be correct, it's simply a system that we've built to let people try and help each other. If something in a feedback response doesn't make sense to you, or you're not comfortable making changes that the feedback talks about (like registry edits), please consult a professional.

Thank you for using kbAlertz.com Feedback System.

-- Scott Cate

Kent - Dzmitry_Lebedzeu NOSPAM-AT-NOSPAM epam.com Report As Irrelevant  
Written: 11/6/2007 7:57 AM
Hi, great job done! But can u tell how should I replace the code " ' Exchange Server Name. strExchSvrName = "ExchangeServerName" ' Alias of the sender. strAlias = "user1" ' User Name of the sender. strUserName = "DomainName\user1" ' Password of the sender. strPassWord = "password" ' Email address of the sender. strFrom = "user1@somewhere.com" ' Email address of recipient. strTo = "user2@somewhere.com" ' Subject of the mail. strSubject = "Mail Subject" ' Text body of the mail. strBody = "Mail Body" " if I want to send email from my mailbox at hotmail.com to another mailbox at hotmailcom: For Example from name1@hotmail.com to name2@hotmail.com, the name@hotmail.com mailbox has password "1234"? Ty in advance!!!



Copyright © 2002-2007 KBALERTZ.COM.  All Rights Reserved. Terms / Privacy. Discount ASP.NET Hosting