Delete Windows 7 network printer driver remotely using WMI - windows-7

I need some help with deleting network printer driver remotely on a Windows 7 client machine using a vbscript with an account having administrator privileges (Elevated Account) on the remote computer. The problem is that I can't delete the connected printer the user have connected. Everything else seems to work. Below is the code for the script.
The script does several things, but the ultimate goal is to physically remove the printer-drivers. The current version of the script fails since the driver files are in use. The script contains code to avoid deleting special printers. It also stops and starts the print spooler.
intSleep = 4000
strService = " 'Spooler' "
strComputer = "<remote computer name>"
Set fsobj = CreateObject("Scripting.FileSystemObject") 'Calls the File System Object
Set objNetwork = CreateObject("WScript.Network")
arrPrinters = Array("PDF", "Adobe", "Remote", "Fax", "Microsoft", "Send To", "Generic")
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
' List drivers
Set colInstalledPrinters = objWMIService.ExecQuery _
("Select * from Win32_PrinterDriver")
Set drivrutinCol = CreateObject("Scripting.Dictionary")
For each objPrinter in colInstalledPrinters
' Wscript.Echo "Configuration File: " & objPrinter.ConfigFile
' Wscript.Echo "Data File: " & objPrinter.DataFile
' Wscript.Echo "Description: " & objPrinter.Description
' Wscript.Echo "Driver Path: " & objPrinter.DriverPath
' Wscript.Echo "File Path: " & objPrinter.FilePath
' Wscript.Echo "Help File: " & objPrinter.HelpFile
' Wscript.Echo "INF Name: " & objPrinter.InfName
' Wscript.Echo "Monitor Name: " & objPrinter.MonitorName
' Wscript.Echo "Name: " & objPrinter.Name
' Wscript.Echo "OEM Url: " & objPrinter.OEMUrl
' Wscript.Echo "Supported Platform: " & objPrinter.SupportedPlatform
' Wscript.Echo "Version: " & objPrinter.Version
if InArray(objPrinter.Name, arrPrinters ) = False then
Wscript.Echo "Name: " & objPrinter.Name
drivrutinCol.Add drivrutinCol.Count, Replace(objPrinter.ConfigFile, "C:", "\\" & strComputer & "\c$")
drivrutinCol.Add drivrutinCol.Count, Replace(objPrinter.DataFile, "C:", "\\" & strComputer & "\c$")
drivrutinCol.Add drivrutinCol.Count, Replace(objPrinter.DriverPath, "C:", "\\" & strComputer & "\c$")
end if
Next
' Remove network printers
Const NETWORK = 22
Set colInstalledPrinters = objWMIService.ExecQuery _
("Select * From Win32_Printer")
For Each objPrinter in colInstalledPrinters
If objPrinter.Attributes And NETWORK Then
' The code never gets here for user connected network printers
End If
Next
' Stop Print Spooler Service
Set colListOfServices = objWMIService.ExecQuery _
("Select * from Win32_Service Where Name ="_
& strService & " ")
For Each objService in colListOfServices
objService.StopService()
WSCript.Sleep intSleep
Next
' Delete drivers
for i = 0 to drivrutinCol.Count-1
Wscript.Echo "Deleting driver: " & drivrutinCol.Item(i)
fsobj.DeleteFile(drivrutinCol.Item(i))
Next
' Start Print Spooler Service
For Each objService in colListOfServices
WSCript.Sleep intSleep
objService.StartService()
Next
Function InArray(item,myarray)
Dim i
For i=0 To UBound(myarray) Step 1
If InStr(lcase(item), lcase(myarray(i)))>0 Then
InArray=True
Exit Function
End If
Next
InArray=False
End Function
The failing part of the code is the "Remove network printers" - part. The script does not list the network printers that the user have connected in the user profile, but only the local printers connected to the computer profile.

To remove a (network) printer connection of a user who isn't logged in you need to load the user hive into the registry and delete the respective value from the Printers\Connections subkey:
Function qq(str) : qq = Chr(34) & str & Chr(34) : End Function
Set sh = CreateObject("WScript.Shell")
username = "..."
hive = "\\" & strComputer & "\C$\Users\" & username & "\ntuser.dat"
sh.Run "reg load HKU\temp " & qq(hive), 0, True
sh.RegDelete "HKEY_USERS\temp\Printers\Connections\server,printer"
sh.Run "reg unload HKU\temp", 0, True
You need to load the hive from a network share, because unlike other subcommands load and unload don't work with remote registries.
To delete a printer driver (after you removed the printer connection from the user's config) you need to acquire the SeLoadDriverPrivilege first and then remove the respective instance of the Win32_PrinterDriver class (see section "Remarks"):
objWMIService.Security_.Privileges.AddAsString "SeLoadDriverPrivilege", True
qry = "SELECT * FROM Win32_PrinterDriver"
For Each driver In objWMIService.ExecQuery(qry)
If driver.Name = "..." Then driver.Delete_
Next

Related

Out of memory error in vbs scripts

I've been facing this dialogue box just after I start my script
Script: C:\konica.vbs
Line: 14
Char: 1
Error: Out of Memory: 'GetObject'
Code: 800A0007
Source: Microsoft VBScript runtime error
This is my script:
Set wshShell = CreateObject("WScript.Shell")
strCurrDir = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
'### Konica ###
strIPAddress = "192.168.110.168"
strComputer = "."
strPrinterName = "Konica"
strDriverName = "KONICA MINOLTA C353 Series PS"
strLocation = "Konica"
strInfFile = "\\stp\HHard\Printers\KONICA MINOLTA\XP(x86)\BHC353PSWinx86_6500RU\BHC353PSWinx86_6500RU\KOAZXA__.INF"
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,(LoadDriver)}!\\" & strComputer & "\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer Where PortName = 'IP_" & strIPAddress & "' ")
For Each objPrinter in colPrinters
MsgBox "Unable to install printer, printer already found on port 'IP_" & strIPAddress & "'." & VbCrlf & VbCrlf & "Found: " & objPrinter.DeviceID, vbExclamation + vbSystemModal, "Printer Port already assigned"
WSCript.Quit 114001
Next
'MsgBox(strIPAddress)
Set objNewPort = objWMIService.Get("Win32_TCPIPPrinterPort").SpawnInstance_
objNewPort.Name = "IP_" & strIPAddress
objNewPort.Protocol = 1
objNewPort.HostAddress = strIPAddress
objNewPort.PortNumber = "9100"
objNewPort.SNMPEnabled = False
objNewPort.Put_
wshShell.Run "rundll32 printui.dll,PrintUIEntry /if /b """ & strPrinterName & """ /f """ & strInfFile & """ /r ""IP_" & strIPAddress & """ /m """ & strDriverName & """", 1, True
Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer Where DeviceID = '" & strPrinterName & "' ")
For Each objPrinter in colPrinters
objPrinter.Location = strLocation
objPrinter.Put_
Next
You can see, that it script for installing in my system printer 'Konica'. In other system, it script works fine. Where mistake? Please help ?
I'm probably on a wrong tangent here but try giving the MsgBox a variable and then using code that doesn't do anything.
For example:
MsgBox "Unable to install printer, printer already found on port 'IP_" & strIPAddress & "'." & VbCrlf & VbCrlf & "Found: " & objPrinter.DeviceID, vbExclamation + vbSystemModal, "Printer Port already assigned"
becomes
x = MsgBox "Unable to install printer, printer already found on port 'IP_" & strIPAddress & "'." & VbCrlf & VbCrlf & "Found: " & objPrinter.DeviceID, vbExclamation + vbSystemModal, "Printer Port already assigned"
Then you could write
If x Then
Else
End If
Which would run and do nothing because x is always x but there's nothing to run inside the If statement.
That error means that your system is low on memory. The line numbering is questionable in your post, but I would venture a guess that the size of the printer driver is pretty large.

Stop windows services not listed in input file

I am new to VBS scripting and I am wanting to script the stopping of Windows services other than a core set of services. I have currently written a bit of code that will query all local services and output to a text file their running state, I then wish to read from an input file a list of core services NOT to stop however to stop the rest of the services running on that machine. I would like this to be a generic input file so if a service is listed however is not installed on the server for it to continue onto the next service to stop.
Not sure how to proceed with this, would I need to read the input file into an array then do an IF statement to say if objService.Name not equal to the array (somehow) then to stop the service?
Code below - thanks in advance for any assistance/tips
Const ForAppending = 8
strComputer = "."
strLogPath = "C:\Scripts"
strServicesLog = strLogPath & Replace(Wscript.ScriptName,".vbs","") & ".txt"
Set objWMISvc = GetObject( "winmgmts:\\.\root\cimv2" )
Set colItems = objWMISvc.ExecQuery( "Select * from Win32_ComputerSystem", , 48)
' // Create Output Logs folder for script
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.CreateTextFile(strServicesLog, True)
objTS.Write "******************************************************************" & vbcrlf
objTS.Write (Replace(Wscript.ScriptName,".vbs","") & " audit log") & vbcrlf
objTS.Write ("Execution Start: " & FormatDateTime(Now(),2) & " " &
FormatDateTime(Now(),3)) & vbcrlf
For Each objItem in colItems
strComputerName = objItem.Name
objTS.Write vbCrlf & "Server Name: " & strComputerName & vbCrlf
Next
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" &
strComputer & "\root\cimv2")
Set colRunningServices = objWMIService.ExecQuery _
("Select * from Win32_Service")
For Each objService in colRunningServices
objTS.Write "Display Name: " & vbTab & (objService.DisplayName) & vbCrlf
objTS.Write "Service Name: " & vbTab & (objService.Name) & vbCrlf
objTS.Write "Service State: " & vbTab & (objService.State) & vbCrlf
objTS.Write "Start Mode: " & vbTab & (objService.StartMode) & vbCrlf
objTS.WriteLine
Next
objTS.Close
You could read your list of services into a Dictionary object. The Dictionary class has an Exists() method that you can use to test if a string/key exists.
Here's how to read a list of strings (services) from a file named c:\input.txt into a dictionary:
Set d = CreateObject("Scripting.Dictionary")
Set objFileIn = objFS.OpenTextFile("c:\input.txt")
Do Until objFileIn.AtEndOfStream
strService = objFileIn.ReadLine()
If Len(strService) > 0 Then If Not d.Exists(strService) Then d.Add strService, ""
Loop
Later, when you're iterating the list of services on the computer, check the service name against your dictionary:
For Each objService in colRunningServices
' If this service is not in the list of core services, stop it...
If Not d.Exists(objService.Name) Then objService.StopService
Next

How to check the current windows command prompt is hidden by using vbscript or command lines

I want to detecting if the current running bat script is hidden by the caller, that means (nCmdShow=0) for example.
There is windows API to get this information, GetStartupInfo, but it can not be called by command prompt or VBScript(without third party libraries).
The following script can retrieve the startup information, but the problem is that's only works under WinXp, it's doesn't work under Win7. I am looking for a way can support across winxp - win8.
Dim wmiService
Set wmiService = GetObject("winmgmts:\\.\root\cimv2")
Dim startupInfo
Set startupInfo = wmiService.Get("Win32_ProcessStartup")
The following code works fine under xp, but doesn't work under win7, it's show all the startup information.
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_ProcessStartup",,48)
For Each objItem in colItems
Wscript.Echo "CreateFlags: " & objItem.CreateFlags
Wscript.Echo "EnvironmentVariables: " & objItem.EnvironmentVariables
Wscript.Echo "ErrorMode: " & objItem.ErrorMode
Wscript.Echo "FillAttribute: " & objItem.FillAttribute
Wscript.Echo "PriorityClass: " & objItem.PriorityClass
Wscript.Echo "ShowWindow: " & objItem.ShowWindow
Wscript.Echo "Title: " & objItem.Title
Wscript.Echo "WinstationDesktop: " & objItem.WinstationDesktop
Wscript.Echo "X: " & objItem.X
Wscript.Echo "XCountChars: " & objItem.XCountChars
Wscript.Echo "XSize: " & objItem.XSize
Wscript.Echo "Y: " & objItem.Y
Wscript.Echo "YCountChars: " & objItem.YCountChars
Wscript.Echo "YSize: " & objItem.YSize
Next
There is a way of calling API calls in VBS or batch.
appactivate between multiple internet explorer instances
Although the sample given doesn't work 7 and later because of a name conflict. Rename sendmail to something else for 7 and later.
If a limited user you need to manually add the registry entries to hkcu\software\classes.

Can't get WMI namespace RSOP to work

I need to create a subroutine to check for certain policies on a system. I'm currently just trying to do that.
strComputerFQDN is defined at the beginning of the program and that is working fine.
Do you see anything wrong?
Here is my code:
'*************************************************************************
' This Subroutine checks Local Policies
'*************************************************************************
Sub CheckPolicies()
Dim objGPOSrvc,colItems,objItem
Set objGPOSrvc = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputerFQDN & "\root\RSOP")
Set colItems = objGPOSrvc.ExecQuery("SELECT * FROM RSOP_GPO")
WScript.Echo("Check Policies")
WScript.Echo("------------------------------------")
For Each objItem in colItems
If InStr(UCase(objItem.Name),"WSUS") Then
If InStr(UCase(objItem.Name),"SERVER") Then
WScript.Echo("Policy applied: " & objItem.Name)
Else
WScript.Echo("Wrong WSUS Policy Applied - Check Computer object location")
End If
End If
Next
If strWSUSApplied = "FALSE" Then
WScript.Echo("No WSUS Policy Applied!")
End If
WScript.Echo vbCrLf
End Sub
The namespace should be root\RSOP\Computer
Set objGPOSrvc = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputerFQDN & "\root\RSOP\Computer")
or root\RSOP\User
Set objGPOSrvc = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputerFQDN & "\root\RSOP\User")
Most typically you would do something like this:
strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\RSOP\Computer")
Set colItems = objWMIService.ExecQuery("Select * from RSOP_GPO")
For Each objItem in colItems
WScript.Echo "Name: " & objItem.Name
WScript.Echo "GUID Name: " & objItem.GUIDName
WScript.Echo "ID: " & objItem.ID
WScript.Echo "Access Denied: " & objItem.AccessDenied
WScript.Echo "Enabled: " & objItem.Enabled
WScript.Echo "File System path: " & objItem.FileSystemPath
WScript.Echo "Filter Allowed: " & objItem.FilterAllowed
WScript.Echo "Filter ID: " & objItem.FilterId
WScript.Echo "Version: " & objItem.Version
WScript.Echo
Next
If you receive Error 0x80041003, you will need to run this script with administrator credentials. For Vista and later, open your start menu and type cmd. When "Command Prompt" appears, right-click and choose Run As Administrator. You can now launch your script from the elevated command prompt without error.

VbScript, Install exe remotely without user input?

I'm really stuck on a problem so I figured I would get a second opinion(s).
I'm trying to remotely install .exe and .msi to client computers. I have a vb script that downloads the file and runs the file, but there's a few problems. First, I'm having trouble getting it to the run on the local admin account. For testing purposes I'm running it as an Admin and it works fine, but if put on a client computer it would need access to the local Admin.
Secondly, and more importantly, microsoft requires some amount of user input before installing an exe file. I know silent msi install is possible, but I assume silent exe is impossible?
As a solution I'm looking into PsExec, but I feel like I'm missing something here.
For reference, here is my vb script:
Dim TApp
Dim IEObj
Dim tArea
Dim tButton
Const HIDDEN_WINDOW = 12
Const SHOW_WINDOW=1
'Array of Patch files to install.
Dim InstallFiles()
'maximum of 100 workstations to install patches to.
Dim wsNames(100)
Dim numComputers
Dim retVal
Dim PatchFolder
'Create explorer window
Set IEObj=CreateObject("InternetExplorer.Application")
IEObj.Navigate "about:blank"
IEObj.Height=400
IEObj.Width=500
IEObj.MenuBar=False
IEObj.StatusBar=False
IEObj.ToolBar=0
set outputWin=IEObj.Document
outputWin.Writeln "<title>RemotePatchInstall version 1.0</title>"
outputWin.writeln "<HTA:APPLICATION ID='objPatchomatic' APPLICATIONNAME='Patchomatic' SCROLL='no' SINGLEINSTANCE='yes' WINDOWSTATE='normal'>"
outputWin.writeln "<BODY bgcolor=ButtonFace ScrollBar='No'>"
outputWin.writeln "<TABLE cellSpacing=1 cellPadding=1 width='75pt' border=1>"
outputWin.writeln "<TBODY>"
outputWin.writeln "<TR>"
outputWin.writeln "<TD>"
outputWin.writeln "<P align=center><TEXTAREA name=Information rows=6 cols=57 style='WIDTH: 412px; HEIGHT: 284px'></TEXTAREA></P></TD></TR>"
outputWin.writeln "<TR>"
' outputWin.writeln "<TD><P align=center><INPUT id=button1 style='WIDTH: 112px; HEIGHT: 24px' type=button size=38 value='Install Patches' name=button1></P></TD>"
outputWin.writeln "</TR>"
outputWin.writeln "<TR>"
outputWin.writeln "<TD></TD></TR></TBODY></TABLE>"
outputWin.writeln "</BODY>"
IEObj.Visible=True
'Get the Information textarea object from the window
set tempObj=outputWin.getElementsByName("Information")
objFound=false
'loop through its object to find what we need
For each objN in tempObj
if objN.name="Information" then
objFound=true
set tArea=objN
end if
next
'if we didnt find the object theres a problem
if ObjFound=False then
'so show an error and bail
MsgBox "Unable to access the TextBox on IE Window",32,"Error"
WScript.Quit
end if
'*************************
'ADMINS: The below is all you should really have to change.
'*************************
'Change this to the location of the patches that will be installed.
'they should be limited to the amout you try to install at one time.
'ALSO the order they are installed is how explorer would list them by alphabetically.
'So given file names:
'patch1.exe
'patch2.exe
'patch11.exe
'installation order would be patch1.exe,patch11.exe, patch2.exe
PatchFolder="C:\IUware Online\Install\"
'Change this to location where the patches will be copied to on remote cp. This directory must exist on remote computer.
'I have it hidden on all workstations.
RemotePatchFolder="C:\Users\jorblume\Backup\"
'Workstation names to refer to as array
wsNames(1)="129.79.205.153"
'wsNames(2)="192.168.0.11"
'number of remote computers
numComputers=1
'**********************
'ADMINS: The above is all you should really have to change.
'**********************
'Copy files to remote computers.
'Get a list of the executable file in the folder and put them into the InstallFiles array
'on return, retVal will be number of files found.
retVal=GetPatchFileList (PatchFolder,InstallFiles)
'for each file copy to remote computers
For cc=1 to numComputers 'for each computer
For i = 1 to retVal 'for each file
Dim copySuccess
Dim SharedDriveFolder
'do a replacement on the : to $, this means you must have admin priv
'this is because i want to copy to "\\remotecpname\c$\PathName"
SharedDriveFolder=replace(RemotePatchFolder,":","$")
'copy it from the PatchFolder to the path on destination computer
'USE: RemoteCopyFile (SourceFilePath,DestinationFilePath, RemoteComputerName)
CurrentCP=cc
copySuccess=RemoteCopyFile(PatchFolder & "\" & InstallFiles(i),SharedDriveFolder,wsNames(CurrentCP))
if copySuccess=true then
tArea.Value=tArea.Value & PatchFolder & "\" & InstallFiles(i) & " copy - OK" & vbcrlf
else
tArea.Value=tArea.Value & PatchFolder & "\" & InstallFiles(i) & " copy - FAILED" & vbcrlf
end if
Next
Next
'Install the files on remote computer
'go through each filename and start that process on remote PC.
'for each file install them on the computers.
For cc=1 to numComputers
'if theres more than one patch
if retVal>1 then
For i=1 to retVal-1
CurrentCp=cc
'Now create a process on remote computer
'USE: CreateProcessandwait( ComputerName, ExecutablePathonRemoteComputer
'Create a process on the remote computer and waits. Now this can return a program terminated which is ok,
'if it returns cancelled it means the process was stopped, this could happen if the update required a
'computer restart.
CreateProcessandWait wsNames(CurrentCP), RemotePatchFolder & InstallFiles(i) & " /quiet /norestart", tArea
next
end if
'do the last patch with a forcereboot
CreateProcessandWait wsNames(CurrentCP), RemotePatchFolder & InstallFiles(retVal) & " /quiet" & " /forcereboot" , tArea
next
tArea.value=tArea.Value & "Script Complete!" & vbcrlf
'**************************** FUNCTIONS
'Get list of files in Folder.
Function GetPatchFileList(FileFolder, FileStringArray())
'create file system object
Set objFS=CreateObject("Scripting.FileSystemObject")
'set the a variable to point to our folder with the patches in it.
Set objFolder=objFS.GetFolder(FileFolder)
'set the initial file count to 0
numPatches=0
for each objFile in objFolder.Files
if UCase(Right(objFile.Name,4))=".EXE" then
numPatches=numPatches+1
redim preserve FileStringArray(numPatches)
FileStringArray(numPatches)=objFile.Name
end if
next
GetPatchFileList=numPatches
End Function
'Copy files to remote computer.
Function RemoteCopyFile(SrcFileName,DstFileName,DestinationComputer)
Dim lRetVal
'create file system object
Set objFS=CreateObject("Scripting.FileSystemObject")
lRetVal=objFS.CopyFile (SrcFileName, "\\" & DestinationComputer & "\" & DstFileName)
if lRetVal=0 then
RemoteCopyFile=True
else
RemoteCopyFile=False
end if
End Function
'Create process on remote computer and wait for it to complete.
Function CreateProcessAndWait(DestinationComputer,ExecutableFullPath,OutPutText)
Dim lretVal
strComputer= DestinationComputer
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2:Win32_Process")
Set objWMIServiceStart= GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2:Win32_ProcessStartup")
Set objConfig = objWMIServiceStart.SpawnInstance_
objConfig.ShowWindow = 1 'show window or use HIDDEN_WINDOW
lretVal= objWMIService.Create(ExecutableFullPath, null, objConfig, intProcessID)
if lretVal=0 then
OutPutText.Value = OutPutText.Value & "Process created with ID of " & intProcessID & " on " & DestinationComputer & vbcrlf
OutPutText.Value = OutPutText.Value & " Waiting for process " & intProcessID & " to complete." & vbcrlf
WaitForPID strComputer, intProcessID,OutPutText
OutPutText.Value = OutPutText.Value & "Process complete." & vbcrlf
else
OutPutText.Value = OutPutText.Value & "Unable to start process " & ExecutableFullPath & " on " & DestinationComputer & vbcrlf
end if
End Function
'Wait for PRocess to complete
Function WaitForPID(ComputerName,PIDNUMBER,OutPutText)
Dim ProcessNumber
Set objWMIServiceQ = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & ComputerName & "\root\cimv2")
Set colItems = objWMIServiceQ.ExecQuery("Select * from Win32_Process",,48)
For Each objItem in colItems
'check if this process is the one we are waiting for
if objItem.ProcessID=PIDNUMBER then
OutPutText.Value = OutPutText.Value & "Process Info:" & vbcrlf
OutPutText.Value = OutPutText.Value & " Description: " & objItem.Description & vbcrlf
OutPutText.Value = OutPutText.Value & " ExecutablePath: " & objItem.ExecutablePath & vbcrlf
OutPutText.Value = OutPutText.Value & " Name: " & objItem.Name & vbcrlf
OutPutText.Value = OutPutText.Value & " Status: " & objItem.Status & vbcrlf
OutPutText.Value = OutPutText.Value & " ThreadCount: " & objItem.ThreadCount & vbcrlf
ProcessNumber=objItem.ProcessID
end if
Next
PidWaitSQL="SELECT TargetInstance.ProcessID " & " FROM __InstanceDeletionEvent WITHIN 4 " _
& "WHERE TargetInstance ISA 'Win32_Process' AND " _
& "TargetInstance.ProcessID= '" & ProcessNumber & "'"
Set Events = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & ComputerName & "\root\cimv2").ExecNotificationQuery (PidWaitSQL)
Set TerminationEvent = Events.nextevent
OutPutText.Value = OutPutText.Value & "Program " & TerminationEvent.TargetInstance.ProcessID & _
" terminated. " & vbcrlf
set TerminationEvent=Nothing
exit function
End Function
As suggested in the comments, psexec will be your best solution for this scenario. Just don't forget to use /accepteula in its syntax to ensure it doesn't effectively "hang" while waiting for someone to accept its EULA. :) If you have questions or issues with psexec in your installs, comment back here.

Resources