Gmail のテンプレートを起動する VBScript

Google Chrome のアドレスバーに、
https://mail.google.com/mail/?view=cm&fs=1
と入力して［Enter］すると、Gmail の新規作成画面が立ち上がる。
これを利用して Gmail のテンプレートを起動する VBScript を作ってみよう。

Chrome の起動時に、コマンドラインパラメータとして URL を渡すことができるので、下記コードを拡張子 .vbs で保存したファイルをダブルクリックして実行すると Gmail のテンプレートを起動することができる。

CreateGmail.vbs

Option Explicit

Dim newMail     '// https://mail.google.com/mail/?view=cm&fs=1
Dim mailTo      '// 宛先
Dim mailCc      '// CC
Dim mailBcc     '// BCC
Dim mailSu      '// 件名
Dim mailBody    '// 本文
Dim url         '// URL文字列全体

Dim userName    '// ログインユーザ名
Dim kanjiName   '// ログインユーザ漢字名
Dim familyName  '// ログインユーザ姓
Dim mobilePhone '// 携帯番号
Dim eMail       '// E-mailアドレス
Dim mobileStr   '// 署名（携帯番号）

Dim J           '// 改行×1
Dim JJ          '// 改行×2
Dim JJJ         '// 改行×3

'// "%0d%0a"＝改行
J = "%0d%0a"
JJ = J & J
JJJ = J & J & J

userName = CreateObject("WScript.Network").UserName
kanjiName = GetStaffData(userName, 1): If kanjiName = "" Then kanjiName = "-- --"
familyName = Left(kanjiName, InStr(kanjiName, " ") - 1)
eMail = GetStaffData(userName, 2): If eMail = "" Then eMail = "--"
mobilePhone = GetStaffData(userName, 3)

If mobilePhone = "" Then
    mobileStr = ""
Else
    mobileStr = J & "携帯： " & mobilePhone
End If

newMail = "https://mail.google.com/mail/?view=cm&fs=1"
mailTo = "&to=府場 一郎<[e-mail]>"
mailCc = "&cc=保下 花子 <[e-mail]>"
mailSu = "&su=件名をここに入力"

mailBody = "&body=フーバー株式会社 府場様" & JJ & _
            "いつもお世話になっております。 ホゲホゲ株式会社 " & familyName & "です。" & JJJ & _
            "お忙しい中お手数ですが、よろしくお願い致します。" & JJJ & _
            "================================" & J & _
            "ホゲホゲ株式会社" & J & _
            "総務部" & J & _
            kanjiName & JJ & _
            "〒100-8111 東京都千代田区千代田1-1" & J & _
            "TEL： [phone]" & J & _
            "FAX： [phone]" & mobileStr & J & _
            "E-mail： " & eMail & J & _
            "================================" & J

url = newMail & mailTo & mailCc & mailSu & mailBody

Call OpenByChrome(url)

'// コマンドラインパラメータを指定して Google Chrome を起動する

Sub OpenByChrome(url)

    CreateObject("WScript.Shell").Run Chr(34) & GetChromePath & Chr(34) & " " & Chr(34) & url & Chr(34)

End Sub

'// Chromeのパスを返す

Function GetChromePath()

    Dim chromePath      '// Chrome本体のフルパス（x64）
    Dim chrome86Path    '// Chrome本体のフルパス（x86）

    chromePath = "C:\Program Files\Google\Chrome\Application\chrome.exe"
    chrome86Path = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"

    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(chromePath) Then GetChromePath = chromePath: Exit Function
        If .FileExists(chrome86Path) Then GetChromePath = chrome86Path: Exit Function
    End With

    Msgbox "Chrome がありません。": WScript.Quit

End Function

'// 引数にPCログイン名（user_name）とカラムのインデックス（clm）を与えると、
'// スタッフ情報の配列［PCログイン名, 漢字名, メールアドレス, 携帯番号］から
'// 該当するデータを返す

Function GetStaffData(user_name, clm)

    Dim i
    Dim stfArry

    stfArry = GetStaffArry

    GetStaffData = ""
    For i = LBound(stfArry) to UBound(stfArry)
        If stfArry(i, 0) = Lcase(user_name) Then GetStaffData = stfArry(i, clm): Exit For
    next

End Function

'// スタッフ情報の配列

Function GetStaffArry()

    Dim stfArry(1, 3)

    stfArry(0, 0) = "taro_hoge": stfArry(0, 1) = "保下 太郎": stfArry(0, 2) = "[e-mail]": stfArry(0, 3) = "080-1234-5678"
    stfArry(1, 0) = "hanako_hoge": stfArry(1, 1) = "保下 花子": stfArry(1, 2) = "[e-mail]": stfArry(1, 3) = "080-1234-9876"

    GetStaffArry = stfArry

End Function