Экспорт целевых объектов из всех файлов spo в файлы HTM

 

Загрузить как .sbs Показать простым текстом

 

  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
'Описание
'Экспорт сводных таблиц (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
Related pages

...

Navigate from here