Prev: RunAs using a DCOM Client/Server app
Next: VB6: Overflow Error with GetModuleFileName() on Windows Vista
From: the keylime on 27 Jan 2010 15:44
I have this script which I have been writing for a program that is
installed via a regular .exe that needs to be removed
administratively:

Option Explicit

Dim strComputer, strMSI, MSIapp, App, AppToRemove, objShell

strComputer = "."
set objShell = CreateObject("WScript.Shell")

'========================================
AppToRemove = "Cisco MeetingPlace for Outlook"

'
strMSI = UninstallString(AppToRemove)
If strMSI<>"" Then
wscript.echo strMSI
objShell.Run strMSI
End If

function UninstallString(strProductName)
dim strComputer, oReg, strKeyPath, arrSubKeys, subkey, x
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."

Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &
strComputer & "\root\default:StdRegProv")

' Get array of subkeys under uninstall registry entry
strKeyPath = "SOFTWARE\microsoft\windows\currentversion\uninstall"
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys

For Each subkey In arrSubKeys
x=FindUninstallString(subkey, strProductName)
if x<>"" then
if LCase(Left(x,7))="msiexec" then
' Check msiexec for parameters...
if InStr(1,x,"/I")>0 then x=Replace(x, "/I","/X")
if InStr(1,x,"/q")<1 then x=x & " /q"
if InStr(1,x,"/noreboot")<1 then x=x & " /noreboot"
end if
UninstallString=x
exit function
end if
Next
end function

function FindUninstallString(strKey, strProductName)
dim DisplayName, Publisher, UninstallString, search
On Error Resume Next
DisplayName=objShell.RegRead ("HKEY_LOCAL_MACHINE\SOFTWARE
\Microsoft\Windows\CurrentVersion\Uninstall\" & strKey &
"\DisplayName")
Set oShell = CreateObject("Wscript.Shell")
WshShell.SendKeys "{ENTER}"
Publisher=objShell.RegRead ("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft
\Windows\CurrentVersion\Uninstall\" & strKey & "\Publisher")
Set oShell = CreateObject("Wscript.Shell")
WshShell.SendKeys "{LEFT}""{ENTER}"
UninstallString=objShell.RegRead ("HKEY_LOCAL_MACHINE\SOFTWARE
\Microsoft\Windows\CurrentVersion\Uninstall\" & strKey &
"\UninstallString")
Set oShell = CreateObject("Wscript.Shell")
WshShell.SendKeys "{ENTER}"
search = Instr(1, DisplayName, strProductName, 1)

' Get uninstall string
if search>0 Then
if UninstallString="" then UninstallString="MsiExec.exe /X" & strKey
FindUninstallString = UninstallString
end if
end function


When I run this script tho the send keys is not working - it is still
prompting to select the options for me. Any ideas on where I went
wrong?

Thanks!
From: Karl E. Peterson on 27 Jan 2010 18:25
Probably best off asking in microsoft.public.scripting.vbscript

You might also want to include info on the Operating System.

This group's all about ClassicVB, a totally different product.

Good luck...



the keylime submitted this idea :
> I have this script which I have been writing for a program that is
> installed via a regular .exe that needs to be removed
> administratively:
>
> Option Explicit
>
> Dim strComputer, strMSI, MSIapp, App, AppToRemove, objShell
>
> strComputer = "."
> set objShell = CreateObject("WScript.Shell")
>
> '========================================
> AppToRemove = "Cisco MeetingPlace for Outlook"
>
> '
> strMSI = UninstallString(AppToRemove)
> If strMSI<>"" Then
> wscript.echo strMSI
> objShell.Run strMSI
> End If
>
> function UninstallString(strProductName)
> dim strComputer, oReg, strKeyPath, arrSubKeys, subkey, x
> Const HKEY_LOCAL_MACHINE = &H80000002
> strComputer = "."
>
> Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &
> strComputer & "\root\default:StdRegProv")
>
> ' Get array of subkeys under uninstall registry entry
> strKeyPath = "SOFTWARE\microsoft\windows\currentversion\uninstall"
> oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
>
> For Each subkey In arrSubKeys
> x=FindUninstallString(subkey, strProductName)
> if x<>"" then
> if LCase(Left(x,7))="msiexec" then
> ' Check msiexec for parameters...
> if InStr(1,x,"/I")>0 then x=Replace(x, "/I","/X")
> if InStr(1,x,"/q")<1 then x=x & " /q"
> if InStr(1,x,"/noreboot")<1 then x=x & " /noreboot"
> end if
> UninstallString=x
> exit function
> end if
> Next
> end function
>
> function FindUninstallString(strKey, strProductName)
> dim DisplayName, Publisher, UninstallString, search
> On Error Resume Next
> DisplayName=objShell.RegRead ("HKEY_LOCAL_MACHINE\SOFTWARE
> \Microsoft\Windows\CurrentVersion\Uninstall\" & strKey &
> "\DisplayName")
> Set oShell = CreateObject("Wscript.Shell")
> WshShell.SendKeys "{ENTER}"
> Publisher=objShell.RegRead ("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft
> \Windows\CurrentVersion\Uninstall\" & strKey & "\Publisher")
> Set oShell = CreateObject("Wscript.Shell")
> WshShell.SendKeys "{LEFT}""{ENTER}"
> UninstallString=objShell.RegRead ("HKEY_LOCAL_MACHINE\SOFTWARE
> \Microsoft\Windows\CurrentVersion\Uninstall\" & strKey &
> "\UninstallString")
> Set oShell = CreateObject("Wscript.Shell")
> WshShell.SendKeys "{ENTER}"
> search = Instr(1, DisplayName, strProductName, 1)
>
> ' Get uninstall string
> if search>0 Then
> if UninstallString="" then UninstallString="MsiExec.exe /X" & strKey
> FindUninstallString = UninstallString
> end if
> end function
>
>
> When I run this script tho the send keys is not working - it is still
> prompting to select the options for me. Any ideas on where I went
> wrong?
>
> Thanks!

--
..NET: It's About Trust!
http://vfred.mvps.org


 | 
Pages: 1
Prev: RunAs using a DCOM Client/Server app
Next: VB6: Overflow Error with GetModuleFileName() on Windows Vista