asked on
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
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