[VBScript]メールの送信サンプル(CDO)

'
' メールの送信サンプル(CDO)
'

Option Explicit

Const cSMTPServer = "SMTPサーバー"
Const cSMTPPort = 25
Const cSMTPConnectionTimeout = 10
Const cSMTPAuthenticate = 1

Const cSendUserName = "ユーザー名"
Const cSendPassWord = "パスワード"

'==============================================================================
'
' メール送信
'
' 引数
' sFrom 送信元メールアドレス
' sTo 送信先メールアドレス
' sSubject 件名
' sTextBody 本文
' 戻り値
' 成功 True 失敗 False
'==============================================================================
Function SendMail(sFrom, sTo, sSubject, sTextBody)

Const cKeywdSendusing = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Const cKeywdSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const cKeywdSMTPPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Const cKeywdSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Const cKeywdSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Const cKeywdSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Const cKeywdSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"

Dim oMsg

SendMail = False

Set oMsg = CreateObject("CDO.Message")

With oMsg

.From = sFrom
.To = sTo
.Subject = sSubject
.TextBody = sTextBody

.Configuration.Fields.Item(cKeywdSendusing) = 2
.Configuration.Fields.Item(cKeywdSMTPServer) = cSMTPServer
.Configuration.Fields.Item(cKeywdSMTPPort) = cSMTPPort
.Configuration.Fields.Item(cKeywdSMTPConnectionTimeout) = cSMTPConnectionTimeout
.Configuration.Fields.Item(cKeywdSMTPAuthenticate) = 1
.Configuration.Fields.Item(cKeywdSMTPPort) = cSMTPPort
.Configuration.Fields.Item(cKeywdSendUserName) = cSendUserName
.Configuration.Fields.Item(cKeywdSendPassword) = cSendPassWord

.Configuration.Fields.Update

End With

On Error Resume Next

' 送信
oMsg.Send

If Err.Number <> 0 Then
With Err
Dim oShell
Set oShell = WScript.CreateObject("WScript.Shell")
Call oShell.LogEvent( 1,_
"エラー発生!!" & vbCRLF &_
"番号: " & .Number & vbCRLF &_
"内容: " & .Description )
Set oShell = Nothing
.Clear
End With
Else

SendMail = True

End If

On Error GoTo 0

Set oMsg = Nothing

End Function


Dim sFrom, sTo, sSubject, sTextBody

sFrom = "送信元メールアドレス"
sTo = "送信先メールアドレス"
sSubject = "テストメール"
sTextBody = "本文"

If SendMail(sFrom, sTo, sSubject, sTextBody) = True Then
WScript.Echo("メール送信成功。")
Else
WScript.Echo("メール送信失敗！！")
End If