CreateMessage
Sub CreateMessage()
   Dim strSubURI
   Dim strTempURI
   Dim strAlias
   Dim strUserName
   Dim strPassWord
   Dim strExchSvrName
   Dim strTo
   Dim strSubject
   Dim strBody
   Dim strText
   Dim bRequestSuccessful

   ' To use MSXML 3.0, use the following Dim statements.
   Dim xmlReq
   Dim xmlReq2

   ' To use MSXML 4.0, use the following Dim statements.
   ' Dim xmlReq As MSXML2.XMLHTTP40
   ' Dim xmlReq As MSXML2.XMLHTTP40

      ' Exchange server name.
      strExchSvrName = "exName"

      ' Alias of the sender.
      strAlias = "sender"

      ' User name of the sender.
      strUserName = "superv1sor"

      ' Password of the sender.
      strPassWord = "sup3rp@ssw0rd"

      ' E-mail address of the sender.
      strTo = "recipient"

      ' Subject of the mail.
      strSubject = "DAV Message Test"

      ' Text body of the mail.
      strBody = "This message was sent using WebDAV"

      ' Build the submission URI. If Secure Sockets Layer (SSL)
      ' is set up on the server, use "https://" instead of "http://".
      strSubURI = "http://" & strExchSvrName & "/exchange/" & _
         strAlias & "/%23%23DavMailSubmissionURI%23%23/"

      ' Build the temporary URI. If SSL is set up on the
      ' server, use "https://" instead of "http://".
      strTempURI = "http://" & strExchSvrName & "/exchange/" & _
         strAlias & "/%D0%A7%D0%B5%D1%80%D0%BD%D0%BE%D0%B2%D0%B8%D0%BA%D0%B8/" & strSubject & ".eml"

      ' Construct the body of the PUT request.
      ' Note: If the From: header is included here,
      ' the MOVE method request will return a
      ' 403 (Forbidden) status. The From address will
      ' be generated by the Exchange server.
      strText = "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

      ' Initialize.
      bRequestSuccessful = False

      ' To use MSXML 3.0, use the following Set statement.
      Set xmlReq = CreateObject("Microsoft.XMLHTTP")

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

      ' Open the request object with the PUT method and
      ' specify that it will be sent asynchronously. The
      ' message will be saved to the drafts folder of the
      ' specified user's inbox.
      xmlReq.open "PUT", strTempURI, False, strUserName, strPassWord

      ' Set the Content-Type header to the RFC 822 message format.
      xmlReq.setRequestHeader "Content-Type", "message/rfc822"

      ' Send the request with the message body.
      xmlReq.send strText

      ' The PUT request was successful.
      If (xmlReq.Status >= 200 And xmlReq.Status < 300) Then
         bRequestSuccessful = True
      End If

      ' If the PUT request was successful,
      ' MOVE the message to the mailsubmission URI.
      If bRequestSuccessful Then

         WScript.Echo "Lucky You Are."
         ' To use MSXML 3.0, use the following Set statement.
         Set xmlReq2 = CreateObject("Microsoft.XMLHTTP")

         ' To use MSXML 4.0, use the following Set statement.
         ' Set xmlReq2 = CreateObject("Msxml2.XMLHTTP.4.0")

         ' Open the request object with the PUT method and
         ' specify that it will be sent asynchronously.
         xmlReq2.open "MOVE", strTempURI, False, strUserName, strPassWord
         xmlReq2.setRequestHeader "Destination", strSubURI
         xmlReq2.send

         ' The MOVE request was successful.
         If (xmlReq2.Status >= 200 And xmlReq2.Status < 300) Then
            MsgBox "Message was sent to " & strTo & " successfully."

         ' An error occurred on the server.
         ElseIf (xmlReq.Status = 500) Then
            MsgBox "MOVE request status:" & xmlReq.Status & vbCrLf & _
                   "Status text: An error occurred on the server."

         Else
            MsgBox "MOVE request status:" & xmlReq.Status & vbCrLf & _
                "Status text: " & xmlReq.statusText
         End If

      End If

      ' Clean up.
      Set xmlReq = Nothing
      Set xmlReq2 = Nothing

      Exit Sub

End Sub