Microsoft KB Archive/296713

= How To Send a Message from Visual Basic by Using WebDAV =

Article ID: 296713

Article Last Modified on 2/22/2007

-

APPLIES TO


 * Microsoft Exchange 2000 Server Standard Edition
 * Microsoft XML Parser 2.0
 * Microsoft Visual Basic 6.0 Enterprise Edition
 * Microsoft Visual Basic 6.0 Professional Edition

-



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:  In Visual Basic, create a new Standard EXE project. Add a button to the default form and name it Command1.  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 = &quot;ExchangeServerName&quot; ' Alias of the sender. strAlias = &quot;user1&quot; ' User Name of the sender. strUserName = &quot;DomainName\user1&quot; ' Password of the sender. strPassWord = &quot;password&quot; ' Email address of the sender. strFrom = &quot;user1@somewhere.com&quot; ' Email address of recipient. strTo = &quot;user2@somewhere.com&quot; ' Subject of the mail. strSubject = &quot;Mail Subject&quot; ' Text body of the mail. strBody = &quot;Mail Body&quot; strSubURL = FindSubmissionURL(strExchSvrName, _              strAlias, _               strUserName, _               strPassWord) If strSubURL <> &quot;&quot; Then bResult = False bResult = SendMail(strSubURL, _                 strFrom, _                  strTo, _                  strSubject, _                  strBody, _                  strUserName, _                  strPassWord) If bResult Then MsgBox &quot;Successfully send mail via WebDAV!&quot; 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 4.0 use the following Dim statements 'Dim xmlReq As MSXML2.XMLHTTP40 'Dim xmldom As MSXML2.DOMDocument40 'Dim xmlAttr As MSXML2.IXMLDOMAttribute

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

Set xmlReq = CreateObject(&quot;Microsoft.XMLHTTP&quot;)

'To use MSXML 4.0 use the following set statement '  Set xmlReq = CreateObject(&quot;Msxml2.XMLHTTP.4.0&quot;)

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

query = &quot;&quot; query = query + &quot;&quot; query = query + &quot;&quot; query = query + &quot;&quot; query = query + &quot;&quot; query = query + &quot;&quot; xmlReq.send (query) MsgBox xmlReq.Status ' process the result If (xmlReq.Status >= 200 And xmlReq.Status < 300) Then ' MsgBox &quot;Success! &quot; & &quot;PROPFIND Results = &quot; & xmlReq.Status & _ '    &quot;: &quot; & 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 = &quot;urn:schemas:httpmail:&quot; Then baseName = xmlAttr.baseName Exit For End If        Next Set xmlNode = xmlRoot.selectSingleNode(&quot;//&quot; & baseName & &quot;:sendmsg&quot;) FindSubmissionURL = xmlNode.Text ' To use MSXML 4.0 use the following lines of code to get the Submission URL ' Dim objNodeList As IXMLDOMNodeList ' Set objNodeList = xmlRoot.getElementsByTagName(&quot;d:sendmsg&quot;) ' For i = 0 To (objNodeList.length - 1) '  FindSubmissionURL = objNodeList.Item(i).Text ' Next Else MsgBox &quot;Failed to find mail submission URL&quot; FindSubmissionURL = &quot;&quot; End If

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

'Also change the function...

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

'...to the following to accomodate the comments for its use with MSXML 4.0:

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

'       Dim xmlReq As MSXML.XMLHTTPRequest '       Set xmlReq = CreateObject(&quot;Microsoft.XMLHTTP&quot;)

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

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

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

Keywords: kbhowto kbmsg KB296713

-

[mailto:TECHNET@MICROSOFT.COM Send feedback to Microsoft]

© Microsoft Corporation. All rights reserved.