VBA

---

TeraTerm接続マクロ

---

Private Sub CommandButton1_Click()

Dim rc As VbMsgBoxResult
rc = MsgBox("Cドライブ直下にttl接続ディレクトリを作成します。", vbYesNo)
If rc = vbYes Then
Else
    Exit Sub
End If

'最終行取得
Dim LastRow As Integer
LastRow = Range("B6").End(xlDown).row

Dim row As Integer
Dim FileNumber As Integer
Dim newDirectory As String
If Dir("C:\ttl接続", vbDirectory) = "" Then
    newDirectory = "C:\ttl接続"
    MkDir newDirectory
Else
    newDirectory = "C:\ttl接続_" & Format(Now, "yyyymmddHHMMss")
    MkDir newDirectory
End If

    FileNumber = FreeFile
    Dim fileNm As String
    For row = 6 To LastRow
    
        '<番号>.<環境>_<ホスト名>_<IPアドレス>_<ユーザ名>
        fileNm = Cells(row, "B").Value & "." & Cells(row, "C").Value & "_" & Cells(row, "D").Value & "_" & Cells(row, "E").Value & "_" & Cells(row, "F").Value
        
        Open newDirectory & "\" & fileNm & ".ttl" For Append As #FileNumber
        
        Print #FileNumber, "hostname='" & Cells(row, "E").Value & "'"
        Print #FileNumber, "msg=hostname"
        Print #FileNumber, "strconcat msg ':22 /ssh /auth=password /user=" & Cells(row, "F").Value & " /passwd=" & Cells(row, "G").Value & "'"
        
        Print #FileNumber, "Connect msg"
        
        Print #FileNumber, "getdir PWD"
        Print #FileNumber, "logfile=PWD"
        Print #FileNumber, "strconcat logfile '\'"
        Print #FileNumber, "strconcat logfile '" & fileNm & "'"
        Print #FileNumber, "strconcat logfile '.log'"
        Print #FileNumber, "logopen logfile 0 1"
        
        '==============================================================
        
        Print #FileNumber, "wait '#'"
        Print #FileNumber, "sendln 'date;hostname'"
        Close #FileNumber

    Next
    
    MsgBox newDirectory & "ディレクトリの生成が完了しました。"
    
    Dim ShellObj
    Set ShellObj = CreateObject("Shell.Application")
    ShellObj.Explore newDirectory & "\"

End Sub

---

LFで出力

---

Private Sub CommandButton1_Click()

    Dim i As Integer
    Open "C:\Users\usre\Desktop\マクロ\aaa\aaa.txt" For Output As #1

        Print #1, "ABC" & vbLf;
        Print #1, "ABC" & vbLf;

    Close #1

    
End Sub

---

複数テキストファイル内容入力

---

Private Sub CommandButton1_Click()

'    Dim 対象ディレクトリ As String: 対象ディレクトリ = ThisWorkbook.Path
'    Dim strFileName As String: strFileName = Dir(対象ディレクトリ & "\*.txt")
'
'    Do Until strFileName = ""
'        FNo = FreeFile
'        Dim buf As String
'
'            Open 対象ディレクトリ & "\" & strFileName For Input As #FNo
'                Do Until EOF(1)
'                Line Input #FNo, buf
'                n = n + 1
'                Cells(n, 1) = buf
'                Loop
'            Close #FNo
'
'        strFileName = Dir()
'    Loop

    Dim buf As String, Target As String
    Dim 対象ディレクトリ As String: 対象ディレクトリ = ThisWorkbook.Path
    Dim strFileName As String: strFileName = Dir(対象ディレクトリ & "\*.txt")
    
    Do Until strFileName = ""
    With CreateObject("ADODB.Stream")
        .Charset = "UTF-8"
        .Open
        .LoadFromFile 対象ディレクトリ & "\" & strFileName
        buf = .ReadText
        .Close
        tmp1 = Split(buf, vbLf)
            For i = 0 To UBound(tmp1)
            tmp2 = Split(tmp1(i), ",")
            j = j + 1
            Cells(j, 1) = tmp2
            Next i
    strFileName = Dir()
    End With
    Loop


End Sub

Private Sub CommandButton3_Click()

Workbooks.Add
newbk = ActiveWorkbook.Name
'Workbooks(newbk).Activate

With ThisWorkbook.Sheets("差分")
For i = 1 To 5
    If .Cells(16, i) >= 1 Then
        .Rows("19:19").AutoFilter
        .Range("$A$19:$E$22").AutoFilter Field:=i, Criteria1:="=1", Operator:=xlOr, Criteria2:="=3"
        If i <> 1 Then
            .Range(Columns(1), Columns(i - 1)).EntireColumn.Hidden = True
        End If
        If i <> 5 Then
            .Range(Columns(i + 1), Columns(5)).EntireColumn.Hidden = True
        End If
        .Range("A17:H22").Copy Worksheets(1).Cells(Worksheets(1).Cells(10000, 1).End(xlUp).Row + 1, 1)
        .Columns("A:F").EntireColumn.Hidden = False
    End If
Next i
End With

Dim ファイル名 As String: ファイル名 = "差分_" & Format(Now, "yyyymmddhhmmss")
Workbooks(newbk).SaveAs ThisWorkbook.Path & "\" & ファイル名
Workbooks(ファイル名 & ".xlsx").Close

End Sub

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

Private Sub CommandButton1_Click()
    Dim cmdStr1 As String, cmdStr2 As String
    cmdStr1 = "Get-Item ""F:\VBA\02\aaa\111.txt"" | Select-Object -ExpandProperty LastWriteTime"
    cmdStr2 = "Get-Item ""F:\VBA\02\bbb\111.txt"" | Select-Object -ExpandProperty LastWriteTime"
    
    Dim a1 As String, a2 As String
    a1 = ExecCommand(cmdStr1)
    a2 = ExecCommand(cmdStr2)

    If a1 <> a2 Then
        MsgBox "NG"
    Else: MsgBox "OK"
    End If
End Sub

Private Function ExecCommand(command As String) As String
    Dim oExec As Object
    Set oExec = CreateObject("Wscript.shell").Exec("powershell -NoLogo -ExecutionPolicy RemoteSigned -Command " & command)
    oExec.StdIn.Close
    Do While oExec.Status = 0
        Sleep 100
    Loop

    ExecCommand = oExec.StdOut.ReadAll
End Function