VBScriptにおけるMail処理

VBScriptでMailのテンプレートを保存したExcelを読み込んで、OutLookMailを作成

Option Explicit

Dim oExcel
Dim strTo
Dim strCc
Dim strSubject
Dim strBody
Dim strEvrionment
Dim strWorkName
Dim strUserName
Dim strUserFirstName
Dim strFolderPath
Dim strMailAddress
Dim strYYMM
Dim strYoubi
Dim strTime
Dim message
Dim oOutlook
Dim oMail

'************************************************************************
'Excelを開く
'************************************************************************
On Error Resume Next
Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = false

oExcel.WorkBooks.Open(Replace(WScript.ScriptFullName,WScript.ScriptName,"") _
                      & "\MailTempLate.xls")

If Err.number <> 0 Then
 oExcel.Quit
 MsgBox "Excelを正常に開けませんでした。"
 WScript.Quit
End If

'************************************************************************
'メールを編集する
'************************************************************************
strEvrionment = "検証環境"
strWorkName = "ファイル移行"
strUserFirstName = "名字"
strUserName = "名字　太郎"
strMailAddress = "[e-mail]"
strYYMM = Month(Now )& "/" & Day(Now)
StrYoubi = GetYoubi()

message = "移行対象指示書のサーバー上の保存パスを設定してください。"
strFolderPath = InputBox(message, "移行指示書FullPath指定")
WScript.Echo "入力された内容⇒" & strFolderPath

message = "作業開始時間をHH:MM形式で入力してください。"
StrTime = InputBox(message, "作業開始時間　HH:MM")
WScript.Echo "入力された内容⇒" & StrTime

strTo = oExcel.WorkSheets(1).Range("MAIL_TO")
strCc = oExcel.WorkSheets(1).Range("MAIL_CC")

strSubject = oExcel.WorkSheets(1).Range("MAIL_SUBJECT")
strSubject = Replace(strSubject,"@@@環境@@@",strEvrionment)
strSubject = Replace(strSubject,"@@@作業内容@@@",strWorkName)

strBody = oExcel.WorkSheets(1).Range("MAIL_BODY")
strBody = Replace(strBody,"@@@苗字@@@",strUserFirstName)
strBody = Replace(strBody,"@@@環境@@@",strEvrionment)
strBody = Replace(strBody,"@@@作業内容@@@",strWorkName)
strBody = Replace(strBody,"@@@依頼書保存フォルダ@@@",strFolderPath & vbCrLf)
strBody = Replace(strBody,"@@@氏　名@@@",strUserName)
strBody = Replace(strBody,"@@@mailaddress@@@",strMailAddress)
strBody = Replace(strBody,"@@@YY/MM@@@",strYYMM)
strBody = Replace(strBody,"@@@曜日@@@",StrYoubi)
strBody = Replace(strBody,"@@@HH:MM@@@",StrTime)

If err.number <> 0 Then
 oExcel.Quit
 MsgBox "Excelの読み込み中にエラーが発生しました。"
 WScript.Quit
End If

'************************************************************************
'Mailを作成する
'************************************************************************
Set oOutlook = CreateObject("Outlook.Application")
Set oMail = oOutlook.CreateItem(0)

oMail.To = strTo
oMail.Cc = strCc
oMail.Subject=strSubject
oMail.body = strBody

oMail.Display()

WScript.Quit 0

'************************************************************************
'現在の日付に該当する曜日を返す
'************************************************************************
Function GetYoubi()

 GetYoubi = WeekDay(date,2)

 Select Case GetYoubi
  Case 1
   GetYoubi = "月"
  Case 2
   GetYoubi = "火"
  Case 3
   GetYoubi = "水"
  Case 4
   GetYoubi = "木"
  Case 5
   GetYoubi = "金"
  Case 6
   GetYoubi = "土"
  Case 7
   GetYoubi = "日"
  Case Else
   GetYoubi = ""
 End Select

End Function