Question

I have the unfortunate task of sending e-mail through a client that needs to connect to Outlook Anywhere through VBScript. I may not understand the correct terminology when dealing with Exchange Server, therefore the answer may be evading me simply because I don’t know what I’m searching for, and after hours on Google I still haven’t found the answer.

I cannot use SMTP, since the script will be connecting from many locations/networks and they may or may not block the traffic through the default port. I cannot change the default port because the network admin (who is the actual customer) will not change it.

Any pointers in the right direction will be appreciated.

Answer 1

The answer to my question is partially on stackoverflow already at the following question Ways to send E-Mails over MS Exchange with VBScript.

The code below (VBA, but close enough to VBScript) is simply sending a SOAP message to the Exchange Web Service. It was built from various bits and pieces found all over the web (including the links above).

Option Explicit

' ---------------------------------------------------------
' CONFIGURATION - change as needed
' ---------------------------------------------------------
Const TARGETURL = "https://mail.XXXXX.com/ews/exchange.asmx"
Const USERNAME = "XXXXX\dnreply"
Const PASSWORD = "X1X2X3X4X!x@x#x$x%"

Sub SendMessageEWS()
    Dim SOAP
    SOAP = CreateMessageSOAP()

    ' Send the SOAP request, and return the response
    Dim oXMLHTTP, oXml

    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    Set oXml = CreateObject("MSXML2.DOMDocument")

    ' Send the request
    oXMLHTTP.Open "POST", TARGETURL, False, USERNAME, PASSWORD
    oXMLHTTP.setRequestHeader "Content-Type", "text/xml"
    oXMLHTTP.send SOAP

    If oXMLHTTP.Status = "200" Then
        ' Get response
        If oXml.LoadXML(oXMLHTTP.ResponseText) Then
            ' Success
            Debug.Print oXml.XML
        End If
    Else
        Debug.Print oXMLHTTP.ResponseText
        MsgBox "Response status: " & oXMLHTTP.Status
    End If

End Sub

Function CreateMessageSOAP()
    ' Normally this is done by using the DOM, but this is easier for a demo...
    Dim SOAPMsg

    SOAPMsg = SOAPMsg & "<?xml version='1.0' encoding='utf-8'?>"
    SOAPMsg = SOAPMsg & " <soap:Envelope xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' xmlns:t='http://schemas.microsoft.com/exchange/services/2006/types' xmlns:soap='http://schemas.xmlsoap.org/soap/envelope/'>"
    SOAPMsg = SOAPMsg & "   <soap:Body>"
    SOAPMsg = SOAPMsg & "     <CreateItem MessageDisposition='SendAndSaveCopy' xmlns='http://schemas.microsoft.com/exchange/services/2006/messages'>"
    SOAPMsg = SOAPMsg & "         <SavedItemFolderId>"
    SOAPMsg = SOAPMsg & "             <t:DistinguishedFolderId Id='sentitems' />"
    SOAPMsg = SOAPMsg & "         </SavedItemFolderId>"
    SOAPMsg = SOAPMsg & "         <Items>"
    SOAPMsg = SOAPMsg & "             <t:Message>"
    SOAPMsg = SOAPMsg & "                 <t:Subject>Exchange Web Service E-Mail Test</t:Subject>"
' For HTML message body
    SOAPMsg = SOAPMsg & "                 <t:Body BodyType='HTML'><![CDATA[<h1>Test html body</h1>]]></t:Body>"
' For text message body
'    SOAPMsg = SOAPMsg & "                 <t:Body BodyType='Text'><![CDATA[Test text body]]></t:Body>"
    SOAPMsg = SOAPMsg & "                 <t:ToRecipients>"
    SOAPMsg = SOAPMsg & "                     <t:Mailbox>"
    SOAPMsg = SOAPMsg & "                         <t:EmailAddress>[e-mail]</t:EmailAddress>"
    SOAPMsg = SOAPMsg & "                     </t:Mailbox>"
    SOAPMsg = SOAPMsg & "                 </t:ToRecipients>"
    SOAPMsg = SOAPMsg & "             </t:Message>"
    SOAPMsg = SOAPMsg & "         </Items>"
    SOAPMsg = SOAPMsg & "     </CreateItem>"
    SOAPMsg = SOAPMsg & "   </soap:Body>"
    SOAPMsg = SOAPMsg & " </soap:Envelope>"

    CreateMessageSOAP = SOAPMsg
End Function