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

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

Option Explicit

' Целевые объекты (для экспорта в HTML) определяются на основе следующих констант
' Измените следующие 3 строки так, как вам надо
Const bolTABLE = True 	'True означает экспорт всех объектов такого типа
Const bolCHART = True  	'False означает "не экспортировать"
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: Все открытые окна результатов будут закрыты! OK?",vbOkCancel + vbExclamation) _
		= vbCancel Then Exit Sub
			
	bolNoFiles = True	
	'Определим путь к файлам и маску
	strPath		="g:\\temp\\"
	strFileMask	="out*.spo"

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

    While strFname <> ""
'		Debug.Print strFname
		' Открываем Output, делаем его видимым
		Set objOutputDoc = objSpssApp.OpenOutputDoc(strPath & strFname)
		bolNoFiles = False
		objOutputDoc.Visible = True
		' Выделяем все целевые объекты
		Call SelectItems(objOutputDoc)		
		Call ExportTargetItemsToHTML(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 
	If bolNoFiles=True Then MsgBox("Путь " & strPath & strFileMask & " не содержит ни одного файла",vbOK + vbCritical)
	Set objOutputDoc = Nothing
End Sub


'****************************
Sub ExportTargetItemsToHTML ( _
	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 'График
			objItem.Selected = bolCHART
		Case 5	'Сводная таблица
			objItem.Selected = bolTABLE
		Case 10	'Интерактивный график
			objItem.Selected = bolIGRAPH
		Case Else
			objItem.Selected = False
	End Select	
	Next 

End Sub