close all apps except qtp

On Error Resume Next
Dim intWndCnt
Dim oDesc, oWnd
'Create Object description
Set oDesc = Description.Create '
Set oWnd = Desktop.ChildObjects(oDesc)
intWndCnt = oWnd.Count
For i = 0 to intWndCnt - 1
Set TmpObj = oWnd.item(i)
strTmpTitle = oWnd.item(i).GetROProperty("Text")
If instr(1,strTmpTitle, "Google - Windows Internet Explorer",1) > 0 Then
If instr(1,strTmpTitle, "Mercury Quality Center",1) > 0 Then
'msgbox "Title :" & oWnd.item(i).GetROProperty("Text")
Else
'msgbox "Close :" & oWnd.item(i).GetROProperty("Text")
oWnd.item(i).close
End if
End If
Next
'Clean up
Set oDesc = nothing
Set oWnd = nothing