Excelからteraterm操作

Excelで記述された手順書を自動でteratermに打鍵するVBAマクロです。

処理概要

・uniqな画面タイトルを使用したteratermマクロを作成
・teratermマクロを起動してログインを実施
・teratermへのコマンド入力はAppActivateした上でsendkeysで実施
※uniqな画面タイトルなため複数のteraterm画面操作可能

実行にあたって使用するシート

手順シート
・E列に作業内容
・F列に実行サーバ名
・G列に実行したいコマンド

※E列に「設定_ログイン」とある場合はG列に「画面タイトル,IPアドレス,ユーザ,pwd」を記述する
　この値でサーバへログインする

Def_手順シート
・各定義の設定を実施
　（作業列内容、対象列、コマンド列、確認列、開始行、手順シート名など）

Def_login
・teratermでログインするときのマクロを記述
connect '@@IP@@ /user=@@USER@@ /passwd=@@PWD@@'
settitle "@@TITLE@@"
end

Option Explicit

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Dim sp As Variant   'teraterm画面名、IPアドレス、ユーザID、パスワード
Dim svr As Object   'サーバ名を格納する連想配列

Dim wsM As Worksheet    'メインの使用となる手順が記述されたワークシート
Dim wsT As Worksheet    '定義のワークシート
Dim wsh As Object

Dim 作業内容列
Dim 対象列
Dim コマンド列
Dim 確認列
Dim 開始行
Dim 手順シート名
Dim 実施行
Dim 実施列



Sub main()

    Dim rc
    
    '－－－Def手順の設定値取得－－－
    Set wsT = Worksheets("Def_手順")
    
    作業内容列 = wsT.Cells(wsT.Columns("A").Find("作業内容列").Row, 2).Value
    対象列 = wsT.Cells(wsT.Columns("A").Find("対象列").Row, 2).Value
    コマンド列 = wsT.Cells(wsT.Columns("A").Find("コマンド列").Row, 2).Value
    確認列 = wsT.Cells(wsT.Columns("A").Find("確認列").Row, 2).Value
    開始行 = wsT.Cells(wsT.Columns("A").Find("開始行").Row, 2).Value
    手順シート名 = wsT.Cells(wsT.Columns("A").Find("手順シート名").Row, 2).Value
    
    Set wsM = Worksheets(手順シート名)
    Set svr = CreateObject("Scripting.Dictionary")
    Set wsh = CreateObject("WScript.Shell")
    
    wsM.Activate
    
    '－－－メインループ　手順の開始　行ループ－－－
    For 実施行 = 開始行 To wsM.Cells(開始行, コマンド列).End(xlDown).Row
    
        '－－－メイン列ループ－－－
        For 実施列 = 5 To 8
            
            wsM.Cells(実施行, 実施列).Activate
            wsM.Cells(実施行, 実施列).Interior.ColorIndex = 40
            
            '－－－F列はスキップ－－－
            If 実施列 = 6 Then GoTo Continue
            
            '－－－応答ポップアップ－－－
            rc = MsgBox("次は " & Split(Cells(1, 実施列).Address, "$")(1) & 実施行 & " 続行する", vbYesNo, "確認")
            If rc <> vbYes Then End
            
            If 実施列 = 7 Then
            
                '－－－ログイン設定－－－
                If wsM.Cells(実施行, 作業内容列).Value = "設定_ログイン" Then
                    
                    sp = Split(wsM.Cells(実施行, コマンド列).Value, ",")                '画面名、IP、ID、PWDの分解
                    svr.Add wsM.Cells(実施行, 対象列).Value, sp(0) & "_" & Time         '画面名を配列格納呉
                    
                    'Debug.Print svr.Item(wsM.Cells(実施行, 対象列).Value)
                    Call teratermログイン
                
            
                Else
                '－－－teraterm操作－－－
                    Call teraterm操作
                End If
            End If
            
            If 実施列 = 8 Then
                wsM.Cells(実施行, 実施列 + 1).Value = Now()
                wsM.Cells(実施行, 実施列 + 1).Interior.ColorIndex = 4
            End If
            
Continue:
            wsM.Cells(実施行, 実施列).Interior.ColorIndex = 4
        Next 実施列
    Next 実施行
    
    '－－－終了処理－－－
    Set wsT = Nothing
    Set wsM = Nothing
    Set wsh = Nothing
    
End Sub

Sub teraterm操作()
    
    AppActivate svr.Item(wsM.Cells(実施行, 対象列).Value), True
    'debug.print svr.Item(wsM.Cells(実施行, 対象列).Value)
    
    Sleep 500
    
    SendKeys wsM.Cells(実施行, コマンド列).Value
    
    Sleep 500
    
    SendKeys "{ENTER}"

End Sub

Sub teratermログイン()

    Dim rUsed       As Range                '// UsedRange
    Dim r           As Range                '// Cell
    Dim fs          As New FileSystemObject '// FileSystemObject
    Dim ts          As TextStream           '// TextStream
    Dim sFilePath                           '// 出力ファイルパス
    Dim iRow                                '// 現在行
    Dim s                                   '// 出力文字列
    Dim path1
    Dim path2

    
    path1 = ActiveWorkbook.Path & "\tmp"
    path2 = path1 & "\login_macro" & ".ttl"
    
    If Dir(path1, vbDirectory) = "" Then
        MkDir path1
    End If
    
    
    Set ts = fs.CreateTextFile(path2, True, False)
    Set rUsed = Worksheets("Def_login").UsedRange
    
    iRow = 0
    For Each r In rUsed
        If iRow <> r.Row Then
            '// ループ初回時ではない場合
            If r.Row <> rUsed.Row Or r.Column <> rUsed.Column Then
                '// 行が変わったため改行コードを付与
                s = s & vbCrLf
            End If
            
            '// 行の先頭値を連結
            s = s & r.Text
        Else
            '// タブ文字区切りで連結
            s = s & vbTab & r.Text
        End If
        
        iRow = r.Row
    Next
    
    If s <> "" Then
        
        s = Replace(s, "@@TITLE@@", svr.Item(wsM.Cells(実施行, 対象列).Value))
        s = Replace(s, "@@IP@@", sp(1))
        s = Replace(s, "@@USER@@", sp(2))
        s = Replace(s, "@@PWD@@", sp(3))
        Call ts.WriteLine(s)
    End If
    
    Call ts.Close
    
    
    '－－－teraterm起動－－－
    wsh.Run path2, 1, False
    
End Sub

※手順シート

※Def_手順シート

※Def_loginシート