sendmail.vbs

  ' CDO
  Const cdoSendUsingPickup = 1, cdoSendUsingPort = 2
  Const cdoAnonymous = 0, cdoBasic = 1, cdoNTLM = 2
  Const cdoDSNDefault = 0, cdoDSNNever = 1, cdoDSNFailure = 2, cdoDSNSuccess = 4, cdoDSNDelay = 8, cdoDSNSuccessFailOrDelay = 14

  ' FSO
  Const ForReading = 1, ForWriting = 2, ForAppending = 8

  ' Server, port, user and password
  Const MAIL_SERV = "mail.example.com"
  Const MAIL_PORT = 25
  Const MAIL_USER = "someuser"
  Const MAIL_PASS = "somepass"

  On Error Resume Next

  ' global vars
  Dim objArgs, fso
  Dim nExitCode

  ' init
  Set objArgs = WScript.Arguments
  Set fso = CreateObject("Scripting.FileSystemObject")
  nExitCode = Main(objArgs.Count, objArgs)
  WScript.Quit(nExitCode)

' test code
Function Main(argc, argv)
  Dim bResult

  Main = 1
  bResult = SendMail("foo@example.com", _
                     "bar@example.net; baz@example.net", _
                     "log@example.net", _
                     "", _
                     "Test email from CDO", _
                     "Please see the HTML part of this message", _
                     "c:\temp\tmpfile.htm", _
                     Array("c:\temp\file.zip", "c:\temp\file.log"), _
                     False)


  If bResult Then
    Main = 0
  End If
End Function

' Sends an email message
'
' sFrom     sender
' sTo       recipient
' sCc       copy recipient
' sBCc      blind copy recipient
' sSubject  message subject
' sBody     textual body
' sHTMLfile pathname of an HTML file to use for the HTML body
' vaAttach  array containing pathnames for attached files
' bReceipt  flag to enable return receipts
'
Function SendMail(sFrom, sTo, sCc, sBCc, sSubject, sBody, sHTMLfile, vaAttach, bReceipt)
  Dim objMsg, objConf, sConf
  Dim iAtt, sFile

  On Error Resume Next
  SendMail = False
  set objMsg = CreateObject("CDO.Message")
  set objConf = CreateObject("CDO.Configuration")

  ' setup the SMTP client config
  Set objFlds = objConf.Fields
  sConf = "http://schemas.microsoft.com/cdo/configuration/"
  With objFlds
    .Item(sConf & "sendusing") = cdoSendUsingPort
    .Item(sConf & "smtpserver") = MAIL_SERV
    .Item(sConf & "smtpserverport") = MAIL_PORT
    If Len(MAIL_PASS)>0 Then
      .Item(sConf & "smtpauthenticate") = cdoBasic
      .Item(sConf & "sendusername") = ""
      .Item(sConf & "sendpassword") = ""
    Else
      .Item(sConf & "smtpauthenticate") = cdoAnonymous
      .Item(sConf & "sendusername") = ""
      .Item(sConf & "sendpassword") = ""
    End If
    .Update
  End With

  ' create the message
  With objMsg
    ' setup basic infos
    Set .Configuration = objConf
    .From = sFrom
    .To = sTo
    .Cc = sCc
    .BCc = sBcc
    .Subject = sSubject
    .TextBody = sBody
    If Len(sHTMLfile) > 0 Then
      ' got an HTML file for the body
      sFile = GetFileName(sHTMLfile)
      If Len(sFile) > 0 Then
        sFile = "file://" & Replace(GetFileName(sFile), "\", "/")
        .CreateMHTMLBody sFile
      End If
    End If
    For iAtt = LBound(vaAttach) To UBound(vaAttach)
      If Len(vaAttach(iAtt)) > 0 Then
        ' add attachment
        sFile = GetFileName(vaAttach(iAtt))
        If Len(sFile) > 0 Then
          .Addattachment sFile
        End If
      End If
    Next
    If bReceipt = True Then
      ' set return receipt
      sConf = "urn:schemas:mailheader:"
      .Fields(sConf & "disposition-notification-to") = sFrom
      .Fields(sConf & "return-receipt-to") = sFrom
      .DSNOptions = cdoDSNSuccessFailOrDelay
    End If
    .Fields.update
  End With

  ' we're ready, send the message
  Err.Clear
  objMsg.Send

  ' check result/errors
  If Err.Number = 0 Then
    SendMail = True
  End If
End Function

' gets the full pathname for a given file
Function GetFileName(sPathName)
  GetFileName = ""
  If Not fso.FileExists(sPathName) Then
    Exit Function
  End If
  Set fi = fso.GetFile(sPathName)
  GetFileName = fi.Path
End Function