'This script is called by the syntax file "Extract info from Text Output.SPS" ' See that syntax for description of purposes of this script ' http://pages.infinit.net/rlevesqu/index.htm '********************************************************* 'Save the following to a file named "Extract info from Text Output.SBS": '********************************************************* Option Explicit Sub Main Dim objOutput As ISpssOutputDoc If objSpssApp.Documents.OutputDocCount > 0 Then Set objOutput = objSpssApp.GetDesignatedOutputDoc Else MsgBox "You need to run SYSFILE INFO first", vbExclamation End If Call TrimInfoText(objOutput) End Sub '**************************** ' Keep only section between "File Type:" and "Variable Information:" ' Sub TrimInfoText(objOutput As ISpssOutputDoc) '**************************** Dim objItems As ISpssItems Dim objItem As ISpssItem Dim objText As ISpssrtf Dim strText As String Dim lngCount As Long 'number of items in the navigator Dim i As Long 'for-loop index On Error GoTo Oopps Set objItems = objOutput.Items lngCount = objItems.Count ' Find and activate the text For i = lngCount - 1 To 0 Step -1 Set objItem = objItems.GetItem(i) Debug.Print objItem.SPSSType If objItem.SPSSType = SPSSText Then Set objText = objItem.ActivateText Exit For End If Next If objText Is Nothing Then 'couldn't find the Text MsgBox "Run SYSFILE INFO before calling this sub",vbExclamation Exit Sub End If ' Get the current text strText = objText.Text ' Delete section from "Variable Information:" If InStr(strText,"Variable Information:")>1 Then strText = RTrim(Left(strText,InStr(strText,"Variable Information:")-1)) Else MsgBox "The most recent Text Output is not a raw SYSFILE INFO output!", vbCritical, "Error" End If ' Delete section before "File Type:" then assign value to output text strText = Mid(strText,InStr(strText,"File Type:")) objText.Text = strText objItem.Deactivate Exit Sub Oopps: Select Case Err.Number Case Else Debug.Print "Error # " & Err.Number & " " & Err.Description MsgBox "An unexpected error occured. The script will end.", vbCritical Exit Sub End Select End Sub