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