Wednesday, March 27, 2013

Send HTML email from VBScript using CDO

Summary: VBScript to send HTML (and plain text) email.
It's 2013 and apparently there are no tools that would allow you to easily send HTML-formatted email.

Don't get me wrong: of course, Outlook, Thunderbird, Gmail, or whatever client you use, allows (and sometimes forces) you to send email in HTML format, but what if you want to test a format of a message that your application (code) and not you (person) sends? What do you use? Sure, both Outlook and Thunderbird allow you to insert an HTML file as the body of the text, but as soon as you do, they alter your HTML source in a way you you would not imagine, so that the delivered message will show little resemblance to the original.

After wasting several hours with existing email clients and trying available scripting samples (e.g. the ones written by Paul Sadowski and Rob Vanderwoude), I decided to do it the right way and wrote a little utility that would take your HTML file and send it without making any changes to the source code. Lo and behold, here is a VBScript file that you can use for sending email messages:
IMPORTANT: This script requires the helper Common.vbs file to be located in the same folder (or in the PATH).
SendMail.wsf script takes email body from command line or retrieves it from a file. It supports both HTML and plain text formats. You can send your message via a remote mail server or using the local SMTP service. You can also include attachments with the message.

Here is the usage info (you can get this output by running the script with the /? or /h command-line switch): 
cscript //nologo SendMail.wsf /h

DESCRIPTION:

  Sends an email.

USAGE:

  cscript SendMail.wsf [/option[:parameter[;...]]] [...]

OPTIONS:

  from
    Email From address.

  to
    Email To address. Use comma to separate multiple addresses.

  cc
    [Optional] Email CC address. Use commas to separate multiple addresses.

  bcc
    [Optional] Email BCC address. Use commas to separate multiple addresses.

  subject
    [Optional] Email Subject line. 
    [Default: TEST]

  body
    Plain text, HTML text, or path to file containing email message.

  smtp
    [Optional] SMTP server.
    [Default: localhost]

  port
    [Optional] SMTP server port.
    [Default: 25]

  html
    [Optional] Indicates whether email message format is HTML.
    [Values: yes|no|y|n|true|false|t|f]
    [Default: no]

  file
    [Optional] Indicates whether the [/body] parameter points to a file.
    [Values: yes|no|y|n|true|false|t|f]
    [Default: no]

  charset
    [Optional] Specifies character set of the email text (or HTML text).
    [Default: utf-8]

  add
    [Optional] Indicates paths to file attachments.
    Multiple files must be separated by semicolons.

This is how you would invoke the script:

Example 1: Send HTML-formatted email with email body defined in a file and with two JPEG file attachments using local SMTP service

cscript SendMail.wsf /from:me@mail.com /to:a@b.com /cc:"b@c.com,c@d.com" /subject:"Hey!" /body:Test.html /html:y /file:y /add:"a.jpg;b.jpg"
Example 2: Send plan text email using a remote SMTP server

cscript SendMail.wsf /from:me@mail.com /to:a@b.com /cc:"b@c.com,c@d.com" /subject:"Hey!" /body:"How are you?" /html:n /file:n /smtp:"smtp.server.com"

TIP: If you reference files when invoking the script (such as attachments or file containing message body), make sure that you use ether absolute path or path relative to the current directory; otherwise you may get the "File not found" error.
And here is the source code, in case you need to take a peek at the logic: 
<!-------------------------------------------------------------------
  -- DESCRIPTION
  --  Sends email message with optional attachments.
  ------------------------------------------------------------------>
<package>
<job ID="SendMail">

<script Language="VBScript" Src="Common.vbs" />
<script Type="text/vbscript">
Option Explicit

Const SWITCH_FROM  = "from"
Const SWITCH_TO   = "to"
Const SWITCH_CC   = "cc"
Const SWITCH_BCC  = "bcc"
Const SWITCH_SUBJECT = "subject"
Const SWITCH_BODY  = "body"
Const SWITCH_SERVER  = "smtp"
Const SWITCH_PORT  = "port"
Const SWITCH_HTML  = "html"
Const SWITCH_FILE  = "file"
Const SWITCH_ADD  = "add"
Const SWITCH_CHARSET = "charset"

Const SWITCH_ADD_DELIMETER = ";"

Wscript.Quit(Main())

'--------------------------------------------------------------------
' Method
' Main
'
' Description
' Performs the main operation.
'--------------------------------------------------------------------
Function Main()

    Dim strFrom, strTo, strCc, strBcc, strSubject, strBody
    Dim strServer, nPort
    Dim bIsHtml, bIsFile
    Dim strCharset
    Dim arAttachments
    Dim i
    
    Main = -1
    
    ' Make sure the script is executed via cscript (not wscript).
    RevertToCscript(False)

    ' Show help if needed.
    If (IsHelpMode(False)) Then
        ShowHelp()
        Main = 0
        Exit Function
    End If
    
    ' Initialize run-time parameters.
    If Not Initialize _
    ( _
        strFrom, strTo, strCc, strBcc, strSubject, strBody, _
        strServer, nPort, bIsHtml, bIsFile, strCharset, _
        arAttachments _
    ) Then
        Exit Function
    End If
    
    ' Make sure that all files (if any) exist.
    If (bIsFile) Then
        If Not FileExists(GetAbsolutePath(strBody)) Then
            WScript.Echo "File '" & strBody & "' does not exist."
            Exit Function
        End If
    End If
    If GetArraySize(arAttachments) > 0 Then
        For i = LBound(arAttachments) To UBound(arAttachments)
            If Not FileExists(GetAbsolutePath(arAttachments(i))) Then
                WScript.Echo "File '" & arAttachments(i) & "' does not exist."
                Exit Function
            End If
        Next
    End If
    
    ' Get contents of the message body from a file.
    If (bIsFile = True) Then
        strBody = ReadTextFromFileEx(GetAbsolutePath(strBody), strCharset)
    End If
    
    SendEmail _
        strFrom, strTo, strCc, strBcc, _
        strSubject, strBody, strServer, nPort, _
        bIsHtml, strCharset, arAttachments
    
    Main = 0
    
    WScript.Echo "Done."
End Function

'--------------------------------------------------------------------
' Method
' SendEmail
'
' Description
' Sends email using CDO.
'
' Parameters
' Self-explinatory
'--------------------------------------------------------------------
Sub SendEmail _
( _
    ByVal strFrom, _
    ByVal strTo, _
    ByVal strCc, _
    ByVal strBcc, _
    ByVal strSubject, _
    ByVal strBody, _
    ByVal strServer, _
    ByVal nPort, _
    ByVal bIsHtml, _
    ByVal strCharSet, _
    ByRef arAttachments _
)
   ' Standard housekeeping
    Dim i, oEmail

    ' Create an e-mail message object
    Set oEmail = CreateObject("CDO.Message")

    ' Fill in the field values
    With oEmail
        .From = strFrom
        .To = strTo
        
        If Not IsEmptyString(strCc) Then
            .Cc = strCc
        End If
        
        If Not IsEmptyString(strBcc) Then
            .Bcc = strBcc
        End If
        
        .Subject = strSubject
        
        If bIsHtml = True Then
            .HTMLBody = strBody
            .HTMLBodyPart.charset = strCharset
        Else
            .TextBody = strBody
            .TextBodyPart.charset = strCharset
        End If
        
        If GetArraySize(arAttachments) > 0 Then
            For i = LBound(arAttachments) To UBound(arAttachments)
                .AddAttachment Replace(GetAbsolutePath(arAttachments(i)), "\", "\\" ), "", ""
            Next
        End If

        If Not IsEmptyString(strServer) Then
            With .Configuration.Fields
                .Item( "http://schemas.microsoft.com/cdo/configuration/sendusing")  = 2 ' cdoSendUsingPort
                .Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver") = strServer
                .Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport") = nPort
                .Update
            End With
        End If
        
        ' Send the message
        .Send
    End With 

    ' Release the e-mail message object
    Set oEmail = Nothing
End Sub

'--------------------------------------------------------------------
' Method
' Initialize
'
' Description
' Processes command-line switches and initializes run-time
' parameters.
'
' Returns
' True on success; otherwise, False.
'
' Parameters
' Self-explinatory
'--------------------------------------------------------------------
Function Initialize _
( _
    ByRef strFrom, _
    ByRef strTo, _
    ByRef strCc, _
    ByRef strBcc, _
    ByRef strSubject, _
    ByRef strBody, _
    ByRef strServer, _
    ByRef nPort, _
    ByRef bIsHtml, _
    ByRef bIsFile, _
    ByRef strCharset, _
    ByRef arAttachments _
)
    Initialize = False
    
    Dim strValue, strErrMsg
    
    strErrMsg = "Missing required parameter: " 
    
    strFrom = GetParamValue(SWITCH_FROM)
    If (IsEmptyString(strFrom)) Then
        WScript.Echo strErrMsg & SWITCH_FROM
        Exit Function
    End If
    
    strTo = GetParamValue(SWITCH_TO)
    If (IsEmptyString(strTo)) Then
        WScript.Echo strErrMsg & SWITCH_TO
        Exit Function
    End If
    
    strCc  = GetParamValue(SWITCH_CC)
    strBcc  = GetParamValue(SWITCH_BCC)
    
    strSubject = GetParamValue(SWITCH_SUBJECT)
    If (IsEmptyString(strSubject)) Then
        strSubject = "TEST"
    End If
    
    strBody = GetParamValue(SWITCH_BODY)
    If (IsEmptyString(strBody)) Then
        WScript.Echo strErrMsg & SWITCH_BODY
        Exit Function
    End If

    strServer = GetParamValue(SWITCH_SERVER)

    strValue = GetParamValue(SWITCH_PORT)
    If (IsEmptyString(strValue)) Then
        nPort = 25
    Else
        nPort = CInt(strValue)
    End If

    strValue = GetParamValue(SWITCH_HTML)
    If (IsEmptyString(strValue)) Then
        bIsHtml = False
    Else
        strValue = UCase(strValue)
        
        If (strValue = "YES") Or (strValue = "Y") Or _
            (strValue = "TRUE") Or (strValue = "T") Then
            bIsHtml = True
        Else
            bIsHtml = False
        End If
    End If

    strValue = GetParamValue(SWITCH_FILE)
    If (IsEmptyString(strValue)) Then
        bIsFile = False
    Else
        strValue = UCase(strValue)
        
        If (strValue = "YES") Or (strValue = "Y") Or _
            (strValue = "TRUE") Or (strValue = "T") Then
            bIsFile = True
        Else
            bIsFile = False
        End If
    End If

    strValue = GetParamValue(SWITCH_CHARSET)
    If (IsEmptyString(strValue)) Then
        strCharset = "utf-8"
    Else
        strCharset = strValue
    End If

    arAttachments = GetParamValues(SWITCH_ADD, SWITCH_ADD_DELIMETER)
    
    Initialize = True
End Function

'--------------------------------------------------------------------
' Function
' ShowHelp
'
' Description
' Displays help and usage info.
'--------------------------------------------------------------------
Sub ShowHelp()
    Dim strMsg          ' help message

    ' We know that user wants to see help, so generate help message.
    strMsg =    _
    "DESCRIPTION:" & vbCrLf &_
    vbCrLf &_
    "  Sends an email." & vbCrLf &_
    vbCrLf &_
    "USAGE:"  & vbCrLf &_
    vbCrLf &_
    "  cscript " & Wscript.ScriptName &_
    " [/option[:parameter[" & SWITCH_ADD_DELIMETER & "...]]] [...]" & vbCrLf &_
    vbCrLf &_
    "OPTIONS:" & vbCrLf &_
    vbCrLf &_
    "  " & SWITCH_FROM & vbCrLf &_
    "    Email From address." & vbCrLf &_
    vbCrLf &_
    "  " & SWITCH_TO & vbCrLf &_
    "    Email To address. Use comma to separate multiple addresses." & vbCrLf &_
    vbCrLf &_
    "  " & SWITCH_CC & vbCrLf &_
    "    [Optional] Email CC address. Use comma to separate multiple addresses." & vbCrLf &_
    vbCrLf &_
    "  " & SWITCH_BCC & vbCrLf &_
    "    [Optional] Email BCC address. Use comma to separate multiple addresses." & vbCrLf &_
    vbCrLf &_
    "  " & SWITCH_SUBJECT & vbCrLf &_
    "    [Optional] Email Subject line. " & vbCrLf &_
    "    [Default: TEST]" & vbCrLf &_
    vbCrLf &_
    "  " & SWITCH_BODY & vbCrLf &_
    "    Plain text, HTML text, or path to file containing email message." & vbCrLf &_
    vbCrLf &_
    "  " & SWITCH_SERVER & vbCrLf &_
    "    [Optional] SMTP server." & vbCrLf &_
    "    [Default: localhost]" & vbCrLf &_
    vbCrLf &_
    "  " & SWITCH_PORT & vbCrLf &_
    "    [Optional] SMTP server port." & vbCrLf &_
    "    [Default: 25]" & vbCrLf &_
    vbCrLf &_
    "  " & SWITCH_HTML & vbCrLf &_
    "    [Optional] Indicates whether email message format is HTML." & vbCrLf &_
    "    [Values: yes|no|y|n|true|false|t|f]" & vbCrLf &_
    "    [Default: no]" & vbCrLf &_
    vbCrLf &_
    "  " & SWITCH_FILE & vbCrLf &_
    "    [Optional] Indicates whether the [/" & SWITCH_BODY & "] parameter points to a file." & vbCrLf &_
    "    [Values: yes|no|y|n|true|false|t|f]" & vbCrLf &_
    "    [Default: no]" & vbCrLf &_
    vbCrLf &_
    "  " & SWITCH_CHARSET & vbCrLf &_
    "    [Optional] Specifies character set of the email text (or HTML text)." & vbCrLf &_
    "    [Default: utf-8]" & vbCrLf &_
    vbCrLf &_
    "  " & SWITCH_ADD & vbCrLf &_
    "    [Optional] Indicates paths to file attachments." & vbCrLf &_
    "    Multiple files must be separated by semicolons."

    Wscript.Echo strMsg
End Sub

</script>
</job>
</package>
I did use the script to complete my project, but I did not thoroughly test it, so if you run into problems, please let me know.

Posted by Alek Davis at 4:49 PM

Labels:

No comments:

Post a Comment

Subscribe to: Post Comments (Atom)