'
Call UnInstall()

Function UnInstall()
On Error Resume Next

    Dim objWsh
    Dim sTemp1
    Dim sTemp2

    Dim strComputer
    Dim strKey, intRet1

    Dim strEntry1a
    Dim strEntry1b
    Dim strEntry2

    Dim strValue1
    Dim strValue2

    Dim strSubkey
    Dim arrSubkeys
    Dim objReg

    strComputer = "."
    Const HKLM  = &H80000002 'HKEY_LOCAL_MACHINE
    strKey      = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
    strEntry1a  = "DisplayName"
    strEntry1b  = "QuietDisplayName"
    strEntry2   = "UninstallString"

    '// connect
    Set objWsh = CreateObject("WScript.Shell")
    Set objReg = GetObject("winmgmts://" & strComputer & _
             "/root/default:StdRegProv")
    objReg.EnumKey HKLM, strKey, arrSubkeys

    For Each strSubkey In arrSubkeys

        '// get program name
        intRet1 = objReg.GetStringValue(HKLM, strKey & strSubkey, strEntry1a, strValue1)
        If intRet1 <> 0 Then
            objReg.GetStringValue HKLM, strKey & strSubkey, strEntry1b, strValue1
        End If

        sTemp1 = Trim(strValue1)
        If Len(sTemp1) <> 0 Then
        '// Instr(1, sTemp1, "Your Program") to be specific

            '// get uninstall string
            objReg.GetStringValue HKLM, strKey & strSubkey,strEntry2, strValue2
            sTemp2  = Trim(strValue2)

            If Len(sTemp2) <> 0 Then   '// there is an uninstall string
                
                '// see if this is the install shield uninstaller
                '// If Instr(1, strValue2, "uninst.exe", 1) <> 0 Then

                    '// let them know you are going to uninstall
                    '// MsgBox "Uninstalling: " & sTemp1 & vbCrLf & "This will take some time" & _
                    '//        vbCrlf & "please wait ..", vbInformation, "Uninstall"

                    '// add silent and delete all files to install shield uninstaller
                    '// sTemp2  = Replace(sTemp2, ".exe -f", ".exe -a x -f",1,-1,1)

                    '// uninstall now
                    '// objWsh.Run sTemp2, 3, True

                '// End If

                MsgBox "Program Name: " & sTemp1 & vbCrLf & sTemp2

                If Err <> 0 Then Exit For

           End If
        End If
    Next

    If Err = 0 Then
        UnInstall = True
    End If
End Function