Source/VBS/MailSend

Option Explicit
' ============================================================================ '
'  メール送信テスト (MailSendTest.vbs)
' ============================================================================ '
' メール設定
Const MAIL_CHARSET = "utf-8" ' "us-ascii","utf-8","iso-2022-jp","shift-jis","euc-jp"
Const MAIL_XMAILER = "MailSend Test VBScript" ' "Microsoft CDO for Windows 2000"

' メール送信設定(PICKUP_DIR が空欄の場合に SMTP で送信)
Const PICKUP_DIR   = "C:\inetpub\mailroot\Pickup" ' Pickup directory. Typically, "C:\Inetpub\mailroot\pickup"
Const SMTP_SERVER  = "smtp.example.net" ' SMTPサーバ
Const SMTP_PORT    = 25 ' SMTPポート番号(25/587/465)
Const SMTP_USE_SSL = False ' SSL通信するか True/False
Const SMTP_AUTH_MODE = 0 ' 0:認証なし, 1:BASIC認証, 2:NTLM認証,
Const SMTP_AUTH_USER = "" ' BASIC認証時のユーザ名
Const SMTP_AUTH_PASS = "" ' BASIC認証時のパスワード

' メール送信者・宛先設定
Const MAIL_FROM = "system@example.net" ' 送信者
Const MAIL_TO  = "username1@example.net, username2@example.net" ' 宛先


Dim subject, textBody, objWshNet
Set objWshNet = CreateObject("WScript.Network")

' 件名と本文
subject = "メール送信テスト"
textBody= "メール送信テスト" & vbNewLine & "Time: " & Now() & vbNewLine & "Host: " & objWshNet.ComputerName & vbNewLine & "User: " & objWshNet.UserName

' 送信
MailSend MAIL_TO, subject, textBody

WScript.Echo "メール送信完了"

Set objWshNet = Nothing
WScript.Quit

' ============================================================================ '
Sub MailSend(mailto, subject, textBody)
    MailSendImp MAIL_FROM, mailto, "", "", "", subject, textBody, "", Split("", "/")
End Sub

Sub MailSendImp(fmAddr, toAddr, ccAddr, bccAddr, replyToAddr, subject, textBody, htmlBody, attch())
    Dim objCdoMsg, i
    Set objCdoMsg = CreateObject("CDO.Message")

    objCdoMsg.From = fmAddr
    objCdoMsg.To = toAddr
    If ccAddr <> "" Then objCdoMsg.Cc = ccAddr
    If bccAddr <> "" Then objCdoMsg.Bcc = bccAddr
    If replyToAddr <> "" Then objCdoMsg.ReplyTo =replyToAddr

    objCdoMsg.Subject = subject
    If textBody <> "" Then objCdoMsg.TextBody = textBody
    If htmlBody <> "" Then objCdoMsg.HtmlBody = htmlBody
    objCdoMsg.BodyPart.Charset = MAIL_CHARSET

    For i = LBound(attch) To UBound(attch)
        objCdoMsg.AddAttachment attch(i)
    Next

    ' メール情報設定
    With objCdoMsg.Fields
        ' メーラー
        If MAIL_XMAILER <> "" Then .Item("urn:schemas:mailheader:X-Mailer") = MAIL_XMAILER
        '' 重要度設定
        '.Item("urn:schemas:mailheader:Importance") = "High"
        '.Item("urn:schemas:mailheader:Priority") = 1
        '.Item("urn:schemas:mailheader:X-Priority") = 1
        '.Item("urn:schemas:mailheader:X-MsMail-Priority") = "High"
        ' 更新
        .Update
    End With

    ' 送信情報設定
    With objCdoMsg.Configuration.Fields
        ' SMTP サーバ情報
        If PICKUP_DIR <> "" Then
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 1 ' Pickup directory
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverpickupdirectory") = PICKUP_DIR
        Else
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 ' リモートSMTP
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTP_SERVER
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTP_PORT
            '.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = SMTP_USE_SSL
        End If
        ' SMTP-AUTH 認証情報 (BASIC認証時)
        If SMTP_AUTH_MODE = 1 Then
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = SMTP_AUTH_MODE
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = SMTP_AUTH_USER
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = SMTP_AUTH_PASS
        End If
        ' 更新
        .Update
    End With

    ' メール送信
    On Error Resume Next
    objCdoMsg.Send
    If Err.Number <> 0 Then
        If LCase(Right(WScript.FullName,11)) = "wscript.exe" Then
            ' WScript
            WScript.Echo "Send mail error." & vbNewLine & "No=" & Err.Number & " Msg=" & Err.Description & vbNewLine & "" & Now()
        Else
            ' CScript
            WScript.StdErr.WriteLine Now() & " Send mail error. No=" & Err.Number & " Msg=" & Err.Description
        End If
        Err.Clear
    End If
    On Error Goto 0
    Set objCdoMsg = Nothing
End Sub
' ============================================================================ '
'   End Of File (MailSendTest.vbs)                                             '
' ============================================================================ '