Avatar of legethi
legethi

asked on 

SSH connectivity test issue with Excel VBA

Hi all,
I need some help on a project that I have. First this is what I'm trying to do.
On an excel Sheet I have a column with IP@. Based on the different IP@, I need to initiate an ssh connection with giving login credential and then log. If the connection is ok, and login password is working I will change the color of the cell or set in a first column that the connection is ok and if login is working set in a second column ok if credential work or failed if credential is not working. I need also that the script wait for the end of the putty before doing the next IP@.

To do this I have try 2 way based on some tips that I found in different forum.
Here is the first way:

Sub Button1_Click()
    Dim wSheet As Worksheet
    Dim wsh As Object
    Set wsh = VBA.CreateObject("WScript.shell")
    'Dim waitOnReturn As Boolean: waitOnReturn = True
    Dim waitOnReturn As Boolean: waitOnReturn = Wait
    Dim WindowStyle As Integer: WindowStyle = 1
    Dim errorCode As Long
    Dim fname As Variant
    Dim FileFormatValue As Long
    Dim login As String
    Dim password As String
    Dim protect As String
    Dim IPAdd As String
    Dim rng As Range, cell As Range
    
    Set rng = Range("B2:B7")
    For Each cell In rng
        IPAdd = cell.Value
        errorCode = wsh.Run("plink " & IPAdd & " -P 22 -l admin -pw Password", WindowStyle, waitOnReturn)
        If errorCode = 0 Then
           MsgBox "Connection to Device Done!"
        Else
           MsgBox "Connection to VSM Sharepoint Failed"
        End If
    Next cell
    
End Sub

Open in new window


the second way is as follow:

Option Explicit

Public Const WM_CLOSE = &H10
Public Const INFINITE = -1&
Public Const SYNCHRONIZE = &H100000
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000



#If VBA7 Then
    Declare PtrSafe Function lbf_ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hwnd As Long, _
    ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
    ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    Declare PtrSafe Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
    Declare PtrSafe Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

#Else
    Declare Function lbf_ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hwnd As Long, _
    ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
    ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    Public Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
    Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
#End If

Function TerminateTunnel()

Dim lngHandle As Long
Dim lngResult As Long

lngHandle = OpenProcess(SYNCHRONIZE Or STANDARD_RIGHTS_REQUIRED Or &HFFF, False, GetWindowHandle("Plink.EXE"))
lngResult = TerminateProcess(lngHandle, 0)
lngResult = CloseHandle(lngHandle)

End Function
Function GetWindowHandle(strWindowName As String) As Long
Dim w As Object
Dim sQuery As String
Dim objAllProcesses As Object
Dim objProcess As Object

    Set w = GetObject("winmgmts:")
    sQuery = "SELECT * FROM win32_process"
    Set objAllProcesses = w.execquery(sQuery)

    For Each objProcess In objAllProcesses
        If objProcess.Name = strWindowName Then
            'Once you get the handle, you cannow exit to function and return the handle
            GetWindowHandle = objProcess.Handle
            'Debug.Print process.Name, process.Handle, process.Caption
            GoTo EXitThisFunction
        End If
    Next
    
EXitThisFunction:

    On Error Resume Next
    Set w = Nothing
    Set objAllProcesses = Nothing
    Set objProcess = Nothing
    
End Function


Function CreateSSHTunnelUsingPutty()

Dim strFilename As String, strCommandLine As String
Dim strCurrPath As String
Dim lngWindowHandle As Long
Dim strServerPOrt As Long
Dim strServerUser As String
Dim strServerPassword As String
Dim IPAdd As String
Dim rng As Range, cell As Range
    
strServerPOrt = 22 'Sample POrt
strServerUser = "admin" 'Sample User Name
strServerPassword = "Password"  'Sample Password

'Set rng = Range("B2:B7")
For Each cell In ActiveSheet.Range("B2:B7")
IPAdd = cell.Value
'strCurrPath = CurrentProject.Path & "\"
strFilename = "Plink.exe"
strCommandLine = IPAdd & " -P " & strServerPOrt & " -l " & strServerUser & " -pw " & strServerPassword

'The command line will look something like this
'  "Server_IP_address -P 22 -l root -pw MyPassword"

'Debug.Print strFilename
'Debug.Print strCommandLine

'Launch tunnel
Call lbf_ShellExecute(0, "open", strFilename, strCommandLine, "", 1)
'Change the last parameter from a one to a zero and the
'connection window will be hidden.

Sleep (1000)
'SetForegroundWindow (GetWindowHandle("Plink.EXE"))

'Send a 'n' (no) which means trusted certificate is not stored on users PC)
SendKeys "n + {ENTER}", True
SendKeys "{ENTER}", True
SendKeys "{ENTER}", True
SendKeys "{ENTER}", True
SendKeys "exit", True
SendKeys "{ENTER}", True
SendKeys "{ENTER}", True

'Tunnel is now created
Next cell

End Function

Open in new window


The issue I face is with the first way, I can't use the sendkeys function due to waitonreturn but this way is waiting that treatment is finish before going to the next cell.
With the second way, I can use the sendkey with no issue but at the difference, the script do not wait that the first putty is finished before going to the next cell IP@

I hope that if it's clear enough but in case, do not hesitate to ask for more clarification
Thanks in advance for your help
Kind Regard
Thibaut
Microsoft DevelopmentMicrosoft Excel

Avatar of undefined
Last Comment
Martin Liss

8/22/2022 - Mon