Search label in Output Window

'Search label in Outpur window

'Begin Description
'This searches the left pane of the Designated Output window for Items
'containing strTitle where strTitle is given by the user at run time. Search is not case sensitive.
'After each find, the item is displayed in right pane and user
'can either continue search or stop it
'Requirement: the Output Document must be open.
'For convenience attach this script to a toolbar button
'End Description

'Author: Raynald Levesque 2003/01/23
'http://pages.infinit.net/rlevesqu/index.htm

Option Explicit

Sub main
	Call SearchLabel()
End Sub


Sub SearchLabel()
' PageTitle in left pane is replaced by content of right pane
' Acts on designated output window

	Dim objOutputDoc As ISpssOutputDoc
	Dim objOutputItems As ISpssItems
	Dim objOutputItem As ISpssItem
	Dim bolFound As Boolean
	Dim strTitle As String
	Dim cnt As Integer

	On Error GoTo Oopps
	bolFound = False

	' Request search string
	strTitle=UCase(InputBox("Enter text","Find Item with the following Label"))
	If Len(strTitle)=0 Then	Exit Sub

	'Get designated output document and items collection
	Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
	Set objOutputItems = objOutputDoc.Items
	objOutputDoc.ClearSelection

	' Check every items
	For cnt = 0 To objOutputItems.Count - 1
		Set objOutputItem = objOutputItems.GetItem(cnt)
		Debug.Print objOutputItem.Label
		If InStr(UCase(objOutputItem.Label),strTitle) > 0 Then
			bolFound = True
			objOutputItem.Selected = True
			If Len(InputBox("OK if yes, Cancel To terminate","Continue search?","Yes")) =0 Then
				Exit Sub
			End If
			objOutputItem.Selected = False
		End If
	Next
	If bolFound =False Then
		MsgBox("No output label contain: " & strTitle)
		Else
		MsgBox("There are no other items containing : " & strTitle)
	End If
Exit Sub

Oopps:
	MsgBox Err.Number & " " & Err.Description	   'inform user
	Debug.Print Err.Number & " " & Err.Description 'for future reference
	'Resume Next 'use Resume Next when debugging script
End Sub