'Описание
' Экспорт сводных таблиц (Pivot Tables) и/или графиков из файлов spo в заданной папке по заданной маске в файлы HTM

' Скрипт обрабатывает все файлы по заданной маске, например, "*.spo", "out*.spo",
' в указанной папке.
' Допустим, первые 2 файла называются "output1.spo" и "myoutput.spo".
' Тогда будет открыт файл "output1.spo", и все сводные таблицы и/или графики будут выделены
' и экспортированы в HTM-файл с именем "output1.htm".
' Аналогично, все таблицы из "myoutput.spo" будут экспортированы в "myoutput.htm".
'Конец описания

' Размещено в SPSSX-L 15.09.2001, автор: rlevesque@videotron.ca
' http://www.spsstools.net

Option Explicit

' Исправьте следующие 2 строки так, как вам нужно
Const bolTABLE = True 	'True означает экспорт всех объектов такого типа
Const bolCHART = True  	'False означает "не экспортировать"


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
	
	'Определим путь к файлам и маску
	strPath		="c:\\temp\\"
	strFileMask	="*.spo"

	'Получаем имя первого файла результатов
	strFname = Dir$(strPath & strFileMask)
	Set objDocuments = objSpssApp.Documents

    While strFname <> ""
'		Debug.Print strFname
		' Открываем Output, делаем его видимым, выделяем все сводные таблицы:
		Set objOutputDoc = objSpssApp.OpenOutputDoc(strPath & strFname)
		objOutputDoc.Visible = True
		Call SelectItems(objOutputDoc)		
		Call ExportPivotTablesToHTML(objOutputDoc, strPath, strFname)
	
		' Для экономии памяти закрываем все файлы output, кроме активного (designated)
		'(использование "objOutputDoc.Close" для активного файла в ранних версиях SPSS "убивает" 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
	
		'Переходим к следующему файлу
		strFname = Dir$()
    Wend 

	Set objOutputDoc = Nothing
End Sub

'****************************
Sub ExportPivotTablesToHTML ( _
	objOutputDoc 	As ISpssOutputDoc, _
	strPath As String, _
	strFname As String)
	
' Экспорт выделенных объектов в HTML
' Имя файла HTM такое же, как и у файла SPO
	
	Dim strFile As String
	On Error GoTo ErrorHand
	
	' Определим имя файла HTML
	strFile = strPath & Left(strFname,InStr(strFname,".")) & "htm"
	Kill strFile 	'Если файл с таким именем уже существует, сотрём его

    ' Экспорт выделенных объектов в HTML
    objOutputDoc.ExportDocument (SpssSelected, strFile, SpssFormatHtml, True)
	Exit Sub
	
	ErrorHand:
	Select Case Err
		Case 10101 'Файл не может быть удалён
			Resume Next
		Case Else
			Debug.Print Err & " " & Err.Description
			MsgBox "К сожалению, произошла ошибка! Попробуйте разобраться, в чём дело."
			Exit Sub
	End Select
End Sub


' выделение объектов заданного типа
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 
	
	' находим и выделяем объекты заданного типа
	For i = lngCount - 1 To 0 Step -1 
		Set objItem = objItems.GetItem(i) 
		Debug.Print objItem.SPSSType
	Select Case objItem.SPSSType
		Case 1 'График
			If bolCHART = True Then 
			objItem.Selected = True 
			Else
			objItem.Selected = False
			End If 
		Case 5	'Сводная таблица
			If bolTABLE=True Then 
			objItem.Selected = True 
			Else
			objItem.Selected = False
			End If 
		Case Else
			objItem.Selected = False
	End Select	
	Next 

End Sub