vbscriptでGmailを送信し、実行ログをファイルに書き込む[No87]

プログラムの自動化で、「処理結果の通知や処理ファイルをメールで受信したい！」と思うことはありませんか？

また、実行した後に「メールプログラムが動いたかどうか確認したい」と思うことはありませんか？

心当たりのある方には、この記事が参考になるかもしれません。「vbscriptでGmailを送信し、実行ログをファイルに書き込むプログラム」についてお話したいと思うので、最後まで読んで頂けたら嬉しいです。

プログラム作成のきっかけ

私には、自宅で定期的に動作しているプログラムがあります。

そのプログラムでは処理結果をファイル出力しているのですが、当初はプログラムを動かしているPCでしか確認することができませんでした。

処理結果が「正常終了」したのか、それとも「エラー／異常終了」したのか、通知を貰って確認したいという思いと、処理結果のファイルを外出時でも確認できるようにしたいという思いから、新たに「vbscriptでGmailを送信し、実行ログをファイルに書き込むプログラム」を作成することになりました。

準備

Gmailアカウントを利用する場合は「アプリパスワード」をあらかじめ取得する必要があります。

下記リンク先のサイト様に、取得方法などがわかりやすく丁寧にまとめられています。やり方がわからない方はもしよければ、そちらを参考にしてみて下さい。

: smtp.gmail.comを使ってメール送信するための設定方法

hoge

続きを見る

プログラム

次のVBSのバッチファイルを用意します。

ファイル保存時は文字コードが"SJIS"か"ANSI"になっていることを確認しましょう。

このプログラムでは添付ファイルが２つあることが前提となっていますが、必要に応じて変更して下さい。

batファイルを作ってVBSを実行する手もあると思います。

「on error resume next」、「on error goto 0」のコメントを外してもいいかもしれません。

メール送信するプログラム

処理結果の通知や処理ファイルをメールで受け取るためのプログラムは下図のようになります。


Option Explicit

Const vbHide = 0

'/*****************************/
'カレントディレクトリのパス
'------------------------------
Dim Fso : Set Fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim Fn  : Fn = Fso.getParentFolderName(WScript.ScriptFullName)
'/*****************************/
Dim LenDyyyy : LenDyyyy = Len("yyyy")
Dim LenDmm   : LenDmm = Len("mm")
Dim LenDdd   : LenDdd = Len("dd")

Dim LenThh   : LenThh = Len("hh")
Dim LenTmm   : LenTmm = Len("mm")
Dim LenTss   : LenTss = Len("ss")

Dim StrNow   : StrNow = Now()
Dim StrYYYYMMDDhhmmss

StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & Year(StrNow)
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & "/"
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & Right("0" & Month(StrNow)  ,2)
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & "/"
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & Right("0" & Day(StrNow)    ,2)
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & "/"
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & Right("0" & Hour(StrNow)   ,2)
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & "/"
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & Right("0" & Minute(StrNow) ,2)
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & "/"
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & Right("0" & Second(StrNow) ,2)

Dim StrTemp : StrTemp = Replace(StrYYYYMMDDhhmmss, "/", "")
StrTemp = Replace(StrTemp, " ", "")
StrTemp = Replace(StrTemp, ":", "")

Dim Dyyyy : Dyyyy = Left(StrTemp, LenDyyyy)
StrTemp = Mid(StrTemp, LenDyyyy + 1)

Dim Dmm : Dmm = Left(StrTemp, LenDmm)
StrTemp = Mid(StrTemp, LenDmm + 1)

Dim Ddd : Ddd = Left(StrTemp, LenDdd)
StrTemp = Mid(StrTemp, LenDdd + 1)

Dim Thh : Thh = Left(StrTemp, LenThh)
StrTemp = Mid(StrTemp, LenThh + 1)

Dim Tmm : Tmm = Left(StrTemp, LenTmm)
StrTemp = Mid(StrTemp, LenTmm + 1)

Dim Tss : Tss = Left(StrTemp, LenTss)
StrTemp = Mid(StrTemp, LenTss + 1)

Dim Dyy : Dyy = Mid(Dyyyy, 3)

Dim FormatNowTime
FormatNowTime = Dyy & "" & Dmm & "" & Ddd & " " & Thh & ":" & Tmm & ":" & Tss
'/*****************************/
Dim mailTo
	mailTo = "xxxxxxxxxxxxxxxxxxxx@gmail.com" '【要変更】TO（送信先）
Dim mailSubject
	mailSubject = "【件名】テストメールの送付について" & "（" & FormatNowTime & "）" '【要変更】件名
Dim mailTextBody
	mailTextBody = "【本文】○○さん　お世話になっております。" & vbCrLf & "こちらは本文です。" & vbCrLf & "宜しくお願いします。" '【要変更】本文
Dim mailAttachment01
	mailAttachment01 = Fn & "\" & "THELIST.txt" '【要変更】添付ファイル01
Dim mailAttachment02
	mailAttachment02 = Fn & "\" & "THELIST.xlsx" '【要変更】添付ファイル02
'/*****************************/

Call SendMail(mailTo, mailSubject, mailTextBody, mailAttachment01 ,mailAttachment02)
Sub SendMail(strMailTo, strMailSubject, strMailTextBody, strMailAttachment01, strMailAttachment02)
	Dim objMail
	Set objMail = CreateObject("CDO.Message")
	
	Dim strMailFrom '名前付けられる '"姓 名 <xxxxxxxxxxxxxxxxxxxx@gmail.com>"
	strMailFrom      = "xxxxxxxxxxxxxxxxxxxx@gmail.com" '【要変更】FROM（送信元）
	
	Dim sendusername '名前付けられない
	sendusername     = "xxxxxxxxxxxxxxxxxxxx@gmail.com" '【要変更】アプリパスワードを取得したアカウント（私は送信元と同じ）
	
	objMail.From     = strMailFrom
	objMail.To       = strMailTo
	objMail.Subject  = strMailSubject 
	objMail.TextBody = strMailTextBody

	Dim objFS
	Set objFS = CreateObject("Scripting.FileSystemObject")
	If objFS.FileExists(strMailAttachment01) = True Then
		objMail.AddAttachment(strMailAttachment01)
	End If
	If objFS.FileExists(strMailAttachment02) = True Then
		objMail.AddAttachment(strMailAttachment02)
	End If
	
	Const strConfigurationField ="http://schemas.microsoft.com/cdo/configuration/"
	With objMail.Configuration.Fields
		.Item(strConfigurationField & "sendusing") = 2
		.Item(strConfigurationField & "smtpserver") = "smtp.gmail.com"
		.Item(strConfigurationField & "smtpserverport") = 465
		.Item(strConfigurationField & "smtpusessl") = true
		.Item(strConfigurationField & "smtpauthenticate") = 1
		.Item(strConfigurationField & "sendusername") = sendusername
		.Item(strConfigurationField & "sendpassword") = "hogehoge" '【要変更】アプリパスワード
		.Item(strConfigurationField & "smtpconnectiontimeout") = 60
		.Update
	End With 'objMail.Configuration.Fields

	on error resume next
		objMail.Send
		
		Dim strMessage
		
		if Err.Number <> 0 then
			strMessage = Err.Description
		else
			'/*****************************/
			strMessage = "送信完了"
			Dim objFS02 : Set objFS02 = WScript.CreateObject("Scripting.FileSystemObject")
			Dim Fn02  : Fn02 = objFS02.getParentFolderName(WScript.ScriptFullName)
			
			Dim OutPutLogVbsFullPath
			OutPutLogVbsFullPath = Fn02 & "\" & "OutPutMailSendLog.vbs"
			
			Dim ObjWSH
			Set ObjWSH = CreateObject("Wscript.Shell")
			ObjWSH.run "cmd /c " & OutPutLogVbsFullPath, vbHide
			'/*****************************/
		end if
	on error goto 0

	Set objMail = Nothing
End Sub

実行時の日時をテキストファイルに追記していくプログラム

実行ログをファイルに書き込むプログラムは下図のようになります。


'------------------------------------------------------------------------
'変数定義
'------------------------------------------------------------------------
Dim filename : filename = "SendMailLog"
Dim extension : extension = ".txt"
'------------------------------------------------------------------------
'カレントディレクトリのパス
'------------------------------------------------------------------------
Dim Fso01 : Set Fso01 = WScript.CreateObject("Scripting.FileSystemObject")
Dim Fn01  : Fn01 = Fso01.getParentFolderName(WScript.ScriptFullName)
'------------------------------------------------------------------------
'処理
'------------------------------------------------------------------------
'MsgBox("01")
'------------------------------------------------------------------------
'ログファイルが存在する　場合：True
'ログファイルが存在しない場合：False
'------------------------------------------------------------------------
Dim Fso03 : Set Fso03 = WScript.CreateObject("Scripting.FileSystemObject") 
Dim Fn03  : Fn03 = Fso03.FileExists(Fn01 & "\" & filename & extension)
'------------------------------------------------------------------------
'ログファイルが存在しなければ作成する：
'------------------------------------------------------------------------
If Fn03 = False Then
  '------------------------------------------------------------------------
  'MsgBox("02")
  'ログファイル作成
  '------------------------------------------------------------------------
  Dim Fso04 : Set Fso04 = WScript.CreateObject("Scripting.FileSystemObject") 
  Dim Fn04  : Set Fn04 = Fso04.CreateTextFile(Fn01 & "\" & filename & extension)
  Fn04.Close
  'Set Fso04 = Nothing
  'Set Fn04 = Nothing
  '------------------------------------------------------------------------
  '5秒間停止する
  'Dim objWsh
  'WScript.Sleep 5000
  '------------------------------------------------------------------------
End If
'------------------------------------------------------------------------ 
'出力処理
'------------------------------------------------------------------------
Dim LenDyyyy : LenDyyyy = Len("yyyy")
Dim LenDmm   : LenDmm = Len("mm")
Dim LenDdd   : LenDdd = Len("dd")

Dim LenThh   : LenThh = Len("hh")
Dim LenTmm   : LenTmm = Len("mm")
Dim LenTss   : LenTss = Len("ss")

Dim StrNow   : StrNow = Now()
Dim StrYYYYMMDDhhmmss

StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & Year(StrNow)
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & "/"
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & Right("0" & Month(StrNow)  ,2)
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & "/"
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & Right("0" & Day(StrNow)    ,2)
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & "/"
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & Right("0" & Hour(StrNow)   ,2)
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & "/"
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & Right("0" & Minute(StrNow) ,2)
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & "/"
StrYYYYMMDDhhmmss = StrYYYYMMDDhhmmss & Right("0" & Second(StrNow) ,2)

Dim StrTemp : StrTemp = Replace(StrYYYYMMDDhhmmss, "/", "")
StrTemp = Replace(StrTemp, " ", "")
StrTemp = Replace(StrTemp, ":", "")

Dim Dyyyy : Dyyyy = Left(StrTemp, LenDyyyy)
StrTemp = Mid(StrTemp, LenDyyyy + 1)

Dim Dmm : Dmm = Left(StrTemp, LenDmm)
StrTemp = Mid(StrTemp, LenDmm + 1)

Dim Ddd : Ddd = Left(StrTemp, LenDdd)
StrTemp = Mid(StrTemp, LenDdd + 1)

Dim Thh : Thh = Left(StrTemp, LenThh)
StrTemp = Mid(StrTemp, LenThh + 1)

Dim Tmm : Tmm = Left(StrTemp, LenTmm)
StrTemp = Mid(StrTemp, LenTmm + 1)

Dim Tss : Tss = Left(StrTemp, LenTss)
StrTemp = Mid(StrTemp, LenTss + 1)

Dim FormatNowTime
FormatNowTime = Dyyyy & "年"
FormatNowTime = FormatNowTime & Dmm & "月"
FormatNowTime = FormatNowTime & Ddd & "日"
FormatNowTime = FormatNowTime & Thh & "時"
FormatNowTime = FormatNowTime & Tmm & "分"
FormatNowTime = FormatNowTime & Tss & "秒"

'MsgBox(FormatNowTime)
Dim LogContents : LogContents = "log_" & filename01 & "_" & FormatNowTime
'------------------------------------------------------------------------
'ログファイル追記
'------------------------------------------------------------------------
Dim Fso05 : Set Fso05 = WScript.CreateObject("Scripting.FileSystemObject") 
Dim Fn05  : Set Fn05 = Fso05.OpenTextFile(Fn01 & "\" & filename & extension, 8, True) '2の場合上書き、8の場合追記 
Fn05.WriteLine(LogContents) 'Writeの場合：改行なし、Writelineの場合：改行あり
'------------------------------------------------------------------------