導入背景

弊社では働き方改革のため、巷で話題のRPAを導入しました。
本社ではWinActorをメインに使用しているみたい。工場では海外展開も考えているのでUiPath
の2本柱になりそう。
プログラマーならUiPathが使いやすいと思う。

ということで、手始めに軽めのやつから作成してみた。

全体感

毎週水曜、給料日前、連休前の規定時刻になったら、残業申請メール（添付ファイル付き）を送信する

・タスクスケジューラで毎日実行させる
・祝日カレンダーを開いて該当の日付かどうか判断
・申請者リストのExcelに電子印があるかチェック
　→なかったら、注意メールを関係者へ送信
　→あったら、残業申請メール（添付ファイル付き）を送信する

Excelで年間のカレンダーがあり、第2金曜とか固定じゃない日付を色付けしておく
↓
このファイルを開いたら自動で、システム日付からチェックする
↓
申請書のExcelを開いて、自動で電子印の存在チェック
↓
バッチファイルを実行

ここまでをSendMail.vbsで動かす

SendMail.vbsのコード

Option Explicit

Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")


Call Main



'***************************************************
'Main
'***************************************************
Sub Main()
Dim TextSub
Dim TextBody
Dim oXlsApp
Dim ContentsLog

Dim Nendo
Nendo = Year(dateadd("m",-3,date()))
Dim DirName
DirName = "\\xxxxxxxxxxxxxxxxxx\新フレックス管理表\" & Nendo & "年度\"

Dim LinkDir
LinkDir = "<file://" & DirName & "定時日時間外労働年間計画書\>"

' Excel起動
Set oXlsApp = CreateObject("Excel.Application")

If oXlsApp Is Nothing Then
 	' Excel起動失敗
 	ContentsLog = "Excel起動失敗"
 	Call WriteLog(ContentsLog)
Else
	oXlsApp.Application.Visible = false
	' --1秒待つ
	WScript.Sleep(1000)
		
	ContentsLog = "該当の日付かチェック　開始"
 	Call WriteLog(ContentsLog)
 	
	dim result
	' --ブックを開く
	Dim xlWB
	 Set xlWB = oXlsApp.Application.Workbooks.Open(DirName & "（正式）" & Nendo & "年度MIC標準カレンダーma.xlsm")
	 ' --Excelの警告を非表示にする
 	 oXlsApp.Application.DisplayAlerts = False
 	 oXlsApp.Visible = False
	result = oXlsApp.application.Worksheets(1).range("B60").value	'該当の日付かチェック
	xlWB.Close False
	
	ContentsLog = "申請書が存在するかチェック　開始"
 	Call WriteLog(ContentsLog)
 	
	Dim resultCheck
	Dim myF
	'xlsmをGET
	For Each myF in fso.GetFolder(DirName & "定時日時間外労働年間計画書\").Files
		If InStr(1,myF.Path,".xlsm") > 0 Then
			resultCheck = myF
			Exit For
		else
			resultCheck = "False"
		End If
		
	Next
	
	
	'該当日付のチェック
	If result = "OK" Then
	 	ContentsLog = "該当の日付です。 "
 		Call WriteLog(ContentsLog)
	
		If resultCheck <> "False" Then
		 	ContentsLog = "該当の申請書を発見！ "
	 		Call WriteLog(ContentsLog)
		
			Dim TargetResult	'印鑑チェック
			Set xlWB = oXlsApp.Application.Workbooks.Open(resultCheck)
			TargetResult = oXlsApp.application.Worksheets(1).range("K1").value
			Dim TargetName	'名前チェック
			TargetName = oXlsApp.application.Worksheets(1).range("K2").value
			xlWB.Close False
	    	
			' --Excel終了
			oXlsApp.Quit
			' --Excelオブジェクトクリア
			Set oXlsApp = Nothing
			
			ContentsLog = "電子印のチェック完了！ "
	 		Call WriteLog(ContentsLog)
			
			'なかったらメール送信
			if TargetResult = 0 or TargetName = 0 then
				ContentsLog = "メール送信開始。 電子印がない  "
 				Call WriteLog(ContentsLog)
				
				TextSub = "【要確認】電子印がありません"
				TextBody = "自動配信メール" & vbcrlf & vbcrlf & "丸山さん、松尾さん" & vbcrlf & vbcrlf & "電子印が押していないため、【自動】残業申請メール処理を中止しました。" & vbcrlf & vbcrlf & "ファイルを確認してください。" & vbcrlf & vbcrlf &  LinkDir
				Call SendMail(TextSub,TextBody)
			
				ContentsLog = "メール送信終了。 電子印がない"
 				Call WriteLog(ContentsLog)
			else
				'すべてがクリアしたら
				if result = "OK" then
					ContentsLog = "UiPath実行開始！ バッチ呼び出し開始  "
	 				Call WriteLog(ContentsLog)
	 				
					Dim oShell
					Set oShell = WScript.CreateObject ("WSCript.shell")
					oShell.run "C:\Users\utf\Documents\UiPath\test\SendMail.bat",0
					
					ContentsLog = "UiPath実行開始！ バッチ呼び出し完了"
	 				Call WriteLog(ContentsLog)
				end if
				Set oShell = Nothing
			end if
		else
			ContentsLog = "メール送信開始  該当の申請書がない！"
	 		Call WriteLog(ContentsLog)
	 		
			' --Excel終了
			oXlsApp.Quit
			' --Excelオブジェクトクリア
			Set oXlsApp = Nothing
			
			TextSub = "【要確認】申請書がありません"
			TextBody = "自動配信メール" & vbcrlf & vbcrlf & "丸山さん、松尾さん" & vbcrlf & vbcrlf & "申請書が存在しないため、【自動】残業申請メール処理を中止しました。" & vbcrlf & vbcrlf & "ファイルを確認してください。" & vbcrlf & vbcrlf &  LinkDir
			Call SendMail(TextSub,TextBody)
			
			ContentsLog = "メール送信終了。 該当の申請書がない！"
 			Call WriteLog(ContentsLog)
		end if
	else
		ContentsLog = "該当日ではありません  "
	 	Call WriteLog(ContentsLog)
	end if
end if
End Sub

'***************************************************
'Mail送信
'***************************************************
Sub SendMail(strSub , strBody)
	Dim UserName
	Dim UserPass
	UserName = "xxxx@yyyyy"
	UserPass = "kimera13"
	
	Dim MailTo
	Dim MailFrom
	Dim MailBcc
	MailTo = "aaaaa@rrrr,hhhh@jjjj,jjjj@kkkk,xxxxx@lllll,"
	MailFrom = "ffff@kkkk"
	MailBcc = "ffff@kkkk"
	
	Dim ServerName
	ServerName = "mail.xxxx"
	Dim objMail
	Set objMail = CreateObject("CDO.Message")
	
	objMail.From = MailFrom
'	objMail.To = UserName
	objMail.To = MailTo
	objMail.Bcc = MailBcc
	objMail.Subject = strSub
	objMail.TextBody = strBody
	'送信方法　1:ローカルSMTPサービスのピックアップ・ディレクトリにメールを配置する 2:SMTPポートに接続して送信 3:OLE DBを利用してローカルのExchangeに接続する
	'SMTPサーバを指定(ホスト名orIP)
	Dim schem
	schem = "http://schemas.microsoft.com/cdo/configuration"
	
	objMail.Configuration.Fields.Item(schem & "/sendusing")        = 2
	objMail.Configuration.Fields.Item(schem & "/smtpserver") = ServerName
	'SMTPポート
	objMail.Configuration.Fields.Item(schem & "/smtpserverport") = 25
	'SSL通信をする/しない
	objMail.Configuration.Fields.Item(schem & "/smtpusessl") = False
	'SMTP認証 1(Basic認証)/2(NTLM認証）
	objMail.Configuration.Fields.Item(schem & "/smtpauthenticate") = 1
	'SMTP送信ユーザ名
	objMail.Configuration.Fields.Item(schem & "/sendusername") = UserName
	'SMTP送信ユーザパスワード
	objMail.Configuration.Fields.Item(schem & "/sendpassword") = UserPass
	'タイムアウト
	objMail.Configuration.Fields.Item(schem & "/smtpconnectiontimeout") = 30
	
	objMail.Configuration.Fields.Update

	objMail.Send

	Set objMail = Nothing
End Sub

'***************************************************
'Log書き込み
'***************************************************
Sub WriteLog(strText)
Dim objLog
Dim TimeStamp
Dim LogFile
LogFile = "C:\Users\utf\Documents\UiPath\test\log\mail_ope_log.txt"
TimeStamp = Date & "_" & Time

Set objLog = fso.OpenTextFile(LogFile,8,False)
objLog.WriteLine(strText & "　　　" & TimeStamp)
objLog.Close
Set objLog = nothing

End Sub



-----------------------------
以下UiPath
![UiPath_main.JPG](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/208182/0d33277d-c08d-5ce3-83cb-08860b45ded4.jpeg)


### 課題
・パスワード、ユーザ名をどうやって持たせるか？
・Windowsセキュリティのスマートなログイン方法は？
・