Excel VBA で Tera Term Macro を実行

Tera Term マクロを Tera Term に読み込ませるのはコマンドラインで実行すればいいので、シェルから実行させる。
現状、参考程度に。

変更点としては
・マクロを実行するプログラムを呼び出す機能を追加
・マクロファイルの保存先をデスクトップに変更

ttpmacro.exe ってば、ttl ファイルの指定がフルパスでない場合に、自分と同じ場所にないと読み込まないという制限がある。
そして、ttpmacro.exe をデフォルトインストールすると、後から追記しようとするファイルがユーザアカウント制御 (UAC) により別管理されることがあり、うまく動いてくれない可能性があるという……
ということで、とりあえずデスクトップに置く仕様にしている。

WSH.SpecialFolders に指定した場所を変えれば、いろいろ対応できそう。

あと、以前実装した ping 機能は、今回は割愛。

応用としては、ttpmacro.exe ではなく ttermpro.exe に、シェル（コマンドライン）からオプション指定してもいい……というか、シンプルな内容ならそちらの方がよさそう。

参考サイト様

ソース

以下、出来上がったソースを。

まず Excel の ThisWorkbook に貼り付けて xlsm 形式で保存する。
A2 以下 A 列にアクセス先サーバ名もしくは IP アドレスを。
B2 以下 B 列に使用するユーザID を。

保存したら、A列に入力したアクセス先をダブルクリックすると、Tera Term が起動してくれる。

なお Tera Term は C ドライブにインストールしている前提。

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
' Excel VBA マクロによる TeraTerm マクロ生成するサンプルソース(暫定版)
' Modify : 黒猫666 - 2013/1/1
' Update : 黒猫666 - 2020/3/20
' Site   : http://d.hatena.ne.jp/KuroNeko666

''' 変数の宣言 ''''''''''''''''''''''''''''''''''''''''''''
' Object 設定
Dim FSO         As Object
Dim TXT         As Object
Dim WSH         As Object

' 変数設定
Dim pFILEDIR    As String       ' 格納先ディレクトリ
Dim pFILE       As String       ' TeraTerm マクロ用ファイル名
Dim pFILEPATH   As String

Dim pHOST       As String       ' アクセスするサーバ用変数
Dim pUSER       As String       ' アクセスユーザ用変数

Dim pPID        As Double

' 列数設定
Dim nHOST       As Integer      ' アクセス先
Dim nUSER       As Integer      ' ユーザID

' Tera Term 実行ファイル
Dim pTTERMDIR   As String       ' インストールフォルダ
Dim pTTMEXE     As String       ' Tera Term マクロ実行
Dim pTTMACROPATH As String      ' インストールパス

' マクロファイル格納先

''' 変数の定義 ''''''''''''''''''''''''''''''''''''''''''''

' デフォルト定義
Set WSH = CreateObject("WScript.Shell")
pFILEDIR = WSH.SpecialFolders("Desktop")

pFILE = "teratermmacro.ttl"
pHOST = "localhost"         ' アクセス先(定義だけ)
pUSER = "default"           ' ユーザID

pFILEPATH = pFILEDIR & "\" & pFILE

' 列の数値定義
nHOST = 1                   ' アクセス先
nUSER = 2                   ' ユーザID

pTTERMDIR = "c:\Program Files (x86)\teraterm"
pTTMEXE = "ttpmacro.exe"
pTTMACROPATH = pTTERMDIR & "\" & pTTMEXE

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' 強制初期化…
Cells(1, 1) = "アクセス先サーバ"
Cells(1, 2) = "ユーザID"

' ダブルクリックしたセルが A 列じゃなかったり、さらに 1 行目だったりしたら、強制終了。
If Intersect(Target, Range("A:A")) Is Nothing Or Target.Row = 1 Then Exit Sub
Cancel = True

' セルの色彩情報で、処理を変更
If Target.Interior.ColorIndex = xlNone Then
    
    ' もしアクセス先の記載がなかったら終了。
    If Target.Value = "" Then
        Exit Sub
    Else
        ' あったら、とりあえず信じ込む。
        pHOST = Target.Value
    End If
    
    Target.Interior.ColorIndex = 6
    
    ' 併せて 2 列目に入力があれば、ユーザIDだと信じ込む。
    If Cells(Target.Row, nUSER) <> "" Then
        pUSER = Cells(Target.Row, nUSER)
    End If
    
Else
    Target.Interior.ColorIndex = xlNone
    Exit Sub
End If

Cancel = True
Set FSO = CreateObject("Scripting.FileSystemObject")
    ' 上書き     : する = true, しない = false (存在したらエラー)
    ' 文字コード : Unicode(UTF) = true, ASCII = false
    Set TXT = FSO.CreateTextFile(pFILEPATH, True, False)
        TXT.WriteLine ("; Generate by Excel VBA (KuroNeko666)")
        TXT.WriteLine ("; Original ttl by TeraTerm sample")
        TXT.WriteLine ("; Creation http://d.hatena.ne.jp/KuroNeko666/20130101")
        TXT.WriteLine ("")
        TXT.WriteLine ("username = '" & pUSER & "'")
        TXT.WriteLine ("hostname = '" & pHOST & "'")
        TXT.WriteLine ("")
        TXT.WriteLine (";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
        TXT.WriteLine ("")
        TXT.WriteLine ("msg = 'Enter password for user '")
        TXT.WriteLine ("strconcat msg username")
        TXT.WriteLine ("passwordbox msg 'Get password'")
        TXT.WriteLine ("")
        TXT.WriteLine ("msg = hostname")
        TXT.WriteLine ("strconcat msg ':22 /ssh /auth=password /user='")
        TXT.WriteLine ("strconcat msg username")
        TXT.WriteLine ("strconcat msg ' /passwd='")
        TXT.WriteLine ("strconcat msg inputstr")
        TXT.WriteLine ("")
        TXT.WriteLine ("connect msg")
        TXT.Close
    Set TXT = Nothing

    ' 作成したマクロを利用して、対象ホストにアクセス

    pPID = Shell(pTTMACROPATH & " " & pFILEPATH)

Set FSO = Nothing

End Sub