VBScriptによるメール送信プログラム

※改版する毎にVer.の数字を上げていきます。
　メジャー・マイナーの区別、改版履歴は特になし。



'---------------------------------------------------------------------------
'VBScriptによるメール送信プログラム　　※要：basp21ファイル。 Ver.002
'---------------------------------------------------------------------------
'暗黙の宣言を不許可（デバック用）
Option Explicit
'エラー検知後も可能な範囲で処理を実行
'On Error Resume Next


'---------------------------------------------------------------------------
'▼変数の宣言と定義の注釈
'---------------------------------------------------------------------------
Dim Bobj 'baspi21呼び出し
Dim SvPortName 'サーバポート
Dim SvName 'サーバ
Dim strMailto '宛先アドレスの定義
Dim MailUserName 'ユーザ名
Dim MailPassword 'パスワード
Dim AddRessList '送信先一覧
Dim AddressNumber '宛先 （To）及び、'同報 （Cc）
Dim Mailfrom '送信元（From）
Dim Sbj '件名 (Subject)
Dim Body '本文 (body)
Dim Files '添付 (files)
Dim result 'メール送信処理


'---------------------------------------------------------------------------
'▼宛先アドレス・リストを設定 ↓↓↓↓設定が必要↓↓↓↓
'---------------------------------------------------------------------------

' 宛先入力ダイアログに表示するリスト
AddRessList = "1 ⇒ 宛先名１" + vbCr + _
"2 ⇒ 宛先名２" + vbCr + _
"3 ⇒ 宛先名３" + vbCr + _
"4 ⇒ 宛先名４" + vbCr + _
"5 ⇒ 宛先名５"


'ダイアログの入力に合わせて送信先のアドレス（変数）を定義
Public Sub SelectAddress
Select Case AddressNumber

Case "1":
strMailto = "宛先名１<[e-mail]>"

Case "2"
strMailto = "宛先名２<[e-mail]>"

Case "3"
strMailto = "宛先名３<[e-mail]>"

Case "4"
strMailto = "宛先名４<[e-mail]>"

Case "5"
strMailto = "宛先名５<[e-mail]>"

Case Else
Msgbox("リストにある数字を半角で入力して下さい。")
call AddressInput

End Select
End Sub


'---------------------------------------------------------------------------
'▼デフォルト入力情報の定義部分。 ↓↓↓↓設定が必要↓↓↓↓
'---------------------------------------------------------------------------

Dim strMailfrom '送信元アドレスのデフォルト値を定義
strMailfrom = "仮の送信元<[e-mail]>"

'メールサーバポート ///25じゃないところも多いので注意。
'各プロパイダの特殊設定はロリポップに一覧あり。
'http://lolipop.jp/?mode=manual&state=mail&state2=wak
SvPortName = "25"

'POP3サーバー
SvName = "sousinnmoto.ne.jp"

'ユーザ名
MailUserName = "[e-mail]"

'パスワード
MailPassword = "tekitou"


'---------------------------------------------------------------------------
'▼プログラム部分。ここから下は変更しないで下さい。
'---------------------------------------------------------------------------
'BASP21 オブジェクト作成
Set Bobj = CreateObject("basp21")


Public Sub AddressInput
AddressNumber = InputBox("宛先を入力して下さい" + vbCr + vbCr + AddRessList,"[宛先の入力]","ここに送信先の番号を半角で入力して下さい。")

call SelectAddress
End Sub

call AddressInput


'送信元（From）
' Mailfrom = InputBox("送信元アドレスを入力して下さい","[送信元アドレスの入力]",strMailfrom)
Mailfrom = strMailfrom

'件名 (Subject)
Sbj = InputBox("メールの件名を入力して下さい","[件名の入力]","ここに件名を入力")

'本文 (body)
Body = InputBox("メールの本文を入力して下さい","[本文の入力]","ここに本文を入力")

'添付 (files)
' Files = InputBox("添付ファイルがあればファイルの拡張子までのフルパスを入力して下さい","[添付ファイルの入力]","")
Files = ""


'メールの件名と本文の両方が空の場合、処理を終了する。
If Sbj="" and Body="" then
msgbox "件名と本文が空です。終了します。"
'処理を終了する。
WScript.Quit
End If
'メールの件名と本文の両方がデフォルト文の場合、処理を終了する。
If Sbj="ここに件名を入力" and Body="ここに本文を入力" then
msgbox "件名と本文が仮の入力のままです。終了します。"
'処理を終了する。
WScript.Quit
End If


'メール送信処理
result = Bobj.SendMail( _
SvName & ":" & SvPortName, _
strMailto, _
Mailfrom, _
Sbj, _
Body, _
Files)

'エラーチェック
If result = "" Then


'送信情報のロギング＜はじまり＞
Dim objFS 'FileSystemObject
Dim objFile
Dim strPath 'ログファイル名
Dim myDate
Dim myTime

'/// 定義の宣言
Set objFS = CreateObject ("Scripting.FileSystemObject")

myDate = FormatDateTime(Date)
myTime = FormatDateTime(time)

'///保存先ファイルの存在確認
strPath = ("SendLog.txt")
If objFS.FileExists(strPath) Then
'/// 保存先ファイルが既にあれば開く。
Set objFile = objFS.GetFile(strPath)

'/// 開いたファイルにデータを挿入。8は追記モード。2を指定すると上書き。
Set objFile = objFile.OpenAsTextStream(8,0)
objFile.WriteLine("-----------------------------------------")
objFile.WriteLine("[" & myDate & "＿" & myTime & "]")
objFile.WriteLine("宛先：" & strMailto)
objFile.WriteLine("件名：" & Sbj)
objFile.WriteLine("本文：" & Body)
objFile.WriteLine(vbcr)
objFile.Close
Else
'/// 保存先ファイルが無ければ作成
Set objFile = objFS.CreateTextFile(strPath,True)
'/// 開いたファイルにデータを挿入。
objFile.WriteLine("-----------------------------------------")
objFile.WriteLine("[" & myDate & "＿" & myTime & "]")
objFile.WriteLine("宛先：" & strMailto)
objFile.WriteLine("件名：" & Sbj)
objFile.WriteLine("本文：" & Body)
objFile.WriteLine(vbcr)
objFile.Close
End If
'送信情報のロギング＜おわり＞


msgbox "送信成功"
Else
msgbox "送信エラー: " & result
End If


'オブジェクト開放
Set Bobj = Nothing




'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
'＝＝　覚え書き
'＝＝　1.要：basp21ファイル。↓
'＝＝　 http://www.hi-ho.ne.jp/babaq/basp21.html
'＝＝　2.デフォルトでccは送らない、添付ファイルは送れない、
'＝＝　 送信者アドレスは入力しない（プログラム中で事前に入力）
'＝＝　 設定になっています。変更は可能。
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝