Hi all,

I have code (see below) that checks how many times a program is
running on my local PC, and close it (or them in case of multiple
instances - tried it with Calculator).
For testing purpose on your local PC, change the strApp = "DMT" to
strApp = "Calculator"
Start a few times "Calculator" and run the Sub CloseDMT() routine.
This is working great, BUT, ...

What i realy need to do is to find out how many instances of a certain
program (DMT.exe) are running on a REMOTE PC, and then with a YES / NO
in a userform act to close the program(s) or skip.

Anyone here who can help me with the changes i need to make to get it
working for the remote PC?
I think that the challenges are in changes in the EnumWindowsProc
function & the CloseApp functions, but i don't understand the code.
Once i can get those of the remote PC, i'll can go on with the forms
and actions


Start with the Sub CloseDMT() routine.
As you can see, i'll defined alreddy a strFullPath to the remote PC.
So the complete path to the program(s) would be like this:
"\\Kndclt21063\Barcoview\Bvw_DMT\bvw_av_prog\Bin\D MT.exe"


Here below is the code i use (for the LOCAL PC):

Option Explicit
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long,
ByVal lParam As Long) As Boolean
Declare Function GetWindowText Lib "user32" Alias
"GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal
cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias
"GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long,
ByVal wCmd As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias
"GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String,
ByVal nMaxCount As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias
"PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam
As Long, lParam As Any) As Long
Function FindWindowHwndLike(hWndStart As Long, ClassName As String,
WindowTitle As String, level As Long, lHolder As Long) As Long
'Public Declare Function GetWindowText Lib "user32" Alias
"GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal
cch As Long) As Long

Public Const GW_HWNDFIRST = 0
Public Const GW_HWNDLAST = 1
Public Const GW_HWNDNEXT = 2
Public Const GW_HWNDPREV = 3
Public Const GW_OWNER = 4
Public Const GW_CHILD = 5
Const WM_CLOSE = &H10

Dim intAppCount As Integer
Dim lngRowOffset As Long

Sub CloseDMT()
Dim strApp As String
Dim strClass As String
Dim I As Integer

Dim strfullpath As String
strfullpath = "\\Kndclt21063\Barcoview\Bvw_DMT\bvw_av_prog\B in\"

strApp = "DMT" '
strClass = ""

lngRowOffset = 1 'preset rowoffset to row 1
Test strApp
For I = 1 To intAppCount
CloseApp strApp, strClass
Next
'clear column A
ThisWorkbook.Sheets("scratchpad").Columns("A").Cle ar

End Sub


Function CloseApp(ByVal strApp As String, ByVal strClass As String) As
Long

'will find a window based on:
'the partial start of the Window title and/or
'the partial start of the Window class
'and then close that window
'for example, this will close Excel:
'CloseApp "", "XLM" and this will:
'CloseApp "Microsoft Excel", ""
'but this won't: CloseApp "", "LM"
'it will only close the first window that
'fulfills the criteria
'will return Hwnd if successfull, and 0 if not
'---------------------------------------------

Dim hwnd As Long

On Error GoTo ERROROUT
hwnd = FindWindowHwndLike(0, strClass, strApp, 0, 0)
If hwnd = 0 Then
CloseApp = 0
Exit Function
End If

'Post a message to the window to close itself
'--------------------------------------------
PostMessage hwnd, WM_CLOSE, 0&, 0&
CloseApp = hwnd
Exit Function
ERROROUT:

On Error GoTo 0
CloseApp = 0

End Function

Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As
Long) As Boolean
Dim strSave As String
Dim lngRet As Long

lngRet = GetWindowTextLength(hwnd)
strSave = Space(lngRet)
GetWindowText hwnd, strSave, lngRet + 1
ThisWorkbook.Sheets("scratchpad").Cells(lngRowOffs et, 1).value =
Str$(hwnd) + " " + strSave
lngRowOffset = lngRowOffset + 1
'continue enumeration
EnumWindowsProc = True
End Function

Sub Test(strApp As String)
Dim MyFileName As Variant
Dim strFileName As String
Dim intHwndLength As Integer

EnumWindows AddressOf EnumWindowsProc, ByVal 0&
'search for strApp
lngRowOffset = 1
intAppCount = 0
Do
strFileName = Trim(Cells(lngRowOffset, 1).value)
MyFileName = Split(strFileName, " ")
intHwndLength = Len(MyFileName(0))
strFileName = Right(strFileName, Len(strFileName) -
intHwndLength)
If Trim(strFileName) = strApp Then
intAppCount = intAppCount + 1
Debug.Print strApp & " found:"; intAppCount & "on row: " &
lngRowOffset
Stop
End If
lngRowOffset = lngRowOffset + 1 'increment rowoffset counter
Loop Until ThisWorkbook.Sheets("scratchpad").Cells(lngRowOffs et,
1).value = ""
Debug.Print "Number of " & strApp & " found:"; intAppCount
End Sub

Thanks in advance for your help ;)

NOTE:
I'll be on vacation until the 3° of January 2012.
I can check the reply on this message, but can't test it at home.

Regards,
Ludo

On 20 dec 2011, 17:16, Ludo wrote:

<SNIPPED

Hi all,

Here's working code i found after 2 days searching the net:

Option Explicit
'
Sub CloseRemoteProgram2()
Dim strComputer As String
Dim strProcess As String
Dim wbemLocator As Object
Dim wbemServices As Object
Dim wbemObjectSet As Object
Dim wbemObject As Object

strComputer = "kndclt21079" 'InputBox("Computer to connect to?")
'strProcess = Inputbox("Process to Kill?")
'strComputer = "iscomputer"
'note: strProcess must be lowercase!
strProcess = "notepad.exe"
Set wbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set wbemServices = wbemLocator.ConnectServer(strComputer)
Set wbemObjectSet = wbemServices.InstancesOf("Win32_Process")
For Each wbemObject In wbemObjectSet
If LCase(wbemObject.Name) = strProcess Then
Debug.Print strProcess & " is running"
wbemObject.Terminate
Debug.Print strProcess & " Terminated"
Set wbemObject = Nothing
Set wbemObjectSet = Nothing
Set wbemServices = Nothing
Set wbemLocator = Nothing
End If
Next
Debug.Print strProcess & " is no more running"

End Sub
Sub GetRunningProcesses()
Dim strComputer As String
Dim objWMIService As Object
Dim colProcesses As Object
Dim objProcess As Object

strComputer = "kndclt21079"
Set objWMIService = GetObject("winmgmts:" &
"{impersonationLevel=impersonate}!\\" & strComputer)
Set colProcesses = objWMIService.ExecQuery("SELECT * FROM
Win32_Process WHERE Name = " & "notepad.exe'")

If colProcesses.Count = 0 Then
Debug.Print "No scripts are running."
Else
For Each objProcess In colProcesses
Debug.Print objProcess.CommandLine
Next
End If
End Sub

Success.

Best regards,
Ludo