Solved

SSH connectivity test issue with Excel VBA

Posted on 2014-11-19
4
304 Views
Last Modified: 2014-12-22
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
0
Comment
Question by:legethi
4 Comments
 
LVL 69

Accepted Solution

by:
Qlemo earned 500 total points
ID: 40453730
If you use WScript.Shell.Exec instead of .Run, you gain control of the (console) application, including status, PID, and standard input/output/error channels. The return is a WshScriptExec object (see http://msdn.microsoft.com/en-us/library/2f38xsxe(v=vs.84).aspx).
0
 

Author Comment

by:legethi
ID: 40453863
Hi Qlemo,

Thanks for this quick feedback and tips.
I will try it asap and let you know the result.
Thanks for your help.
K.R.
Thibaut
0
 
LVL 46

Expert Comment

by:Martin Liss
ID: 40512641
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0

Featured Post

3 Use Cases for Connected Systems

Our Dev teams are like yours. They’re continually cranking out code for new features/bugs fixes, testing, deploying, testing some more, responding to production monitoring events and more. It’s complex. So, we thought you’d like to see what’s working for us.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

831 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question