Export target items of all spo files to HTM file

 

Download as .sbs Shows as plain text

 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
'Begin Description
' Export Pivot Tables, Charts and/or IGRAPH of spo files meeting a "path\\filemask" criteria to HTM
' This script processes all files meeting a given mask, eg "*.spo", "out*.spo"
' and located in a given folder 
' Say first 2 files are named output1.spo and myoutput.spo
' then output1.spo is opened, all Pivot Tables (and/or Charts) are selected then 
' exported To an HTM file named output1.htm
' Similarly, all Pivot Tables of myoutput.spo are exported to myoutput.htm.
' All the files meeting the given mask and located in the given folder are processed
'End Description

' posted to SPSSX-L list on 2001/11/08 by rlevesque@videotron.ca
' http://pages.infinit.net/rlevesqu/index.htm

Option Explicit

' The target items (those to be exported to HTML) are decided based on the following constants
' Modify next 3 lines to fit your requirements
Const bolTABLE = True 	'True means export all such items
Const bolCHART = True  	'False means do not export
Const bolIGRAPH = True  

Sub Main
	Dim objDocuments As ISpssDocuments
	Dim objOutputDoc As ISpssOutputDoc

	Dim strPath As String
	Dim strFileMask As String
	Dim strFname As String
	Dim intCount As Integer
	Dim I As Integer
	Dim bolNoFiles As Boolean
	
	If MsgBox("NB: All currently open Output Window will be closed! OK?",vbOkCancel + vbExclamation) _
		= vbCancel Then Exit Sub
			
	bolNoFiles = True	
	'define file path and mask	
	strPath		="g:\\temp\\"
	strFileMask	="out*.spo"

	'Get the first output file name
	strFname = Dir$(strPath & strFileMask)
	Set objDocuments = objSpssApp.Documents

    While strFname <> ""
'		Debug.Print strFname
		' Open the Output, make it visible
		Set objOutputDoc = objSpssApp.OpenOutputDoc(strPath & strFname)
		bolNoFiles = False
		objOutputDoc.Visible = True
		' Select all target items 
		Call SelectItems(objOutputDoc)		
		Call ExportTargetItemsToHTML(objOutputDoc, strPath, strFname)
	
		' To conserve memory, close all but the designated output document 
		'(using a simple "objOutputDoc.Close" crashes spsswin.exe!)
		intCount = objDocuments.OutputDocCount
		For I = 0 To intCount - 1
			Set objOutputDoc = objDocuments.GetOutputDoc(I)
			If Not objOutputDoc.Designated Then
				objOutputDoc.Close
			End If
		Next
		
		'Get next output file name
		strFname = Dir$()
    Wend 
	If bolNoFiles=True Then MsgBox("The path " & strPath & strFileMask & " does not match any files",vbOK + vbCritical)
	Set objOutputDoc = Nothing
End Sub


'****************************
Sub ExportTargetItemsToHTML ( _
	objOutputDoc As ISpssOutputDoc, _
	strPath As String, _
	strFname As String)
'****************************
	
' Export selected Objects to HTML
' Name of HTM file is same as the name of the SPO file
	
	Dim strFile As String
	On Error GoTo ErrorHand
	
	' Define the name of the file containing the HTML output
	strFile = strPath & Left(strFname,InStr(strFname,".")) & "htm"
	Kill strFile 	'Kill file if it already exists

    ' Export all selected objects to HTML
    objOutputDoc.ExportDocument (SpssSelected, strFile, SpssFormatHtml, True)
	Exit Sub
	
	ErrorHand:
	Select Case Err
		Case 10101 'File could not be killed
			Resume Next
		Case Else
			Debug.Print Err & " " & Err.Description
			MsgBox "Sorry, an error occured! You will have to try to solve the problem."
			Exit Sub
	End Select
End Sub


'****************************
' To select items in the Output which meets the strCriteria
Sub SelectItems(objOutput As ISpssOutputDoc)

'****************************

	Dim objItems As ISpssItems 
	Dim objItem As ISpssItem 
	Dim lngCount As Long
	Dim i As Integer
	
	Set objItems = objOutput.Items 
	lngCount = objItems.Count 
	
	' Find and select items meeting strCriteria
	For i = lngCount - 1 To 0 Step -1 
		Set objItem = objItems.GetItem(i) 
		Debug.Print objItem.SPSSType
	Select Case objItem.SPSSType
		Case 1 'Chart
			objItem.Selected = bolCHART
		Case 5	'Pivot Table
			objItem.Selected = bolTABLE
		Case 10	'IGRAPH
			objItem.Selected = bolIGRAPH
		Case Else
			objItem.Selected = False
	End Select	
	Next 

End Sub
Related pages

...

Navigate from here