Export all pivot tables 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
'Begin Description
' Export Pivot Tables (and/or Charts) 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/09/15 by rlevesque@videotron.ca
' http://pages.infinit.net/rlevesqu/index.htm

Option Explicit

' Modify next 2 lines to fit your requirements
Const bolTABLE = True 	'True means export all such items
Const bolCHART = True  	'False means do not export


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
	
	'define file path and mask	
	strPath		="c:\\temp\\"
	strFileMask	="*.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, select all Pivot Tables:
		Set objOutputDoc = objSpssApp.OpenOutputDoc(strPath & strFname)
		objOutputDoc.Visible = True
		Call SelectItems(objOutputDoc)		
		Call ExportPivotTablesToHTML(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 

	Set objOutputDoc = Nothing
End Sub

'****************************
Sub ExportPivotTablesToHTML ( _
	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
			If bolCHART = True Then 
			objItem.Selected = True 
			Else
			objItem.Selected = False
			End If 
		Case 5	'Pivot Table
			If bolTABLE=True Then 
			objItem.Selected = True 
			Else
			objItem.Selected = False
			End If 
		Case Else
			objItem.Selected = False
	End Select	
	Next 

End Sub
Related pages

...

Navigate from here