導入背景
弊社では働き方改革のため、巷で話題の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
### 課題
・パスワード、ユーザ名をどうやって持たせるか？
・Windowsセキュリティのスマートなログイン方法は？
・