Экспорт в Triple-S

 

Загрузить как .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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
'Begin Description
' Данный скрипт создаёт XML-файл для Triple-S версии 1.2 и соответствующий
' файл данных на основе текущего файла данных SPSS, запрашивая при этом у пользователя папку,
' куда следует сохранить эти файлы. Имя файла XML по умолчанию: <имя_файла_данных_spss>_SSS.XML
' Файл данных экспортируется с тем же префиксом, что и для XML-файла, но с расширением.DAT.
' Создаётся также файл со схемой данных (<префикс_XML>.LST), содержимое которого выводится в окно результатов SPSS Output.
'
' Пользователь также имеет альтернативу вызова данного скрипта из синтаксиса с параметром, в
' котором он указывает путь для сохранения XML-файла, например:
' SCRIPT 'Export2Triple-S.sbs' ("C:\\My Documents\\output.xml").
'End Description

' ПОДРОБНАЯ СПЕЦИФИКАЦИЯ
' Создавая файлы, скрипт не проверяет существование файлов с теми же именами, а просто
' перезаписывает их.
'
' Программа экспортирует все переменные SPSS типа Numeric как
' переменные типов Single или Quantity Triple-S.
' Все прочие типы переменных экспортируются как символьные переменные Triple-S
' (включая переменные типов Comma,Dot,N и научного формата, которые могут содержать
' допустимые числовые данные), так как такие форматы не поддерживаются в качестве допустимых
' количественных (Quantity) форматов в Triple-S.
' При желании пользователь может перед экспортом поменять формат таких типов на Numeric
' (F-формат), если требуется, чтобы при экспорте данные переменные обрабатывались как несимвольные.
' Последний столбец в схеме данных обозначает исходный формат для нестроковых переменных,
' которые при экспорте стали символьными.
'
' Тип Numeric экспортируется в тип Single, если:
' Правило 1) Print-формат для этой переменной не допускает десятичных знаков (т.е. целочисленный формат),
' Правило 2) кроме того, переменная имеет описанные метки значений,
' Правило 3) кроме того, переменная принимает только положительные или нулевые значения, которые описаны среди меток значений.
' Все прочие переменные типа Numeric экспортируются в тип Quantity Triple-S.
'
' Так как нулевые значения в определении типа Triple-S Single не допускаются, переменные с нулевыми
' значениями всё ещё могут экспортироваться в тип Single, но нулевые значения экспортируются как комментарии,
' о чём в журнальном файле будет сделана пометка "zero-value" в последней колонке против такой переменной.
' Если переменная с потенциальным типом Single имеет лишь одну метку значения, которая ассоциирована с 0, такая
' переменная будет экспортирована в тип Quantity.
'
' Если среди меток значений переменной Numeric есть такие, которые используют один или несколько знаков после запятой,
' переменная экспортируется в тип Quantity, но в последней колонке схемы данных против такой переменной
' появляется пометка "labelled". Triple-S позволяет экспорт переменных Quantity с метками
' их значений. Таким образом, если пользователь желает экспортировать переменные в тип Single, он
' должен убедиться, что их Print-формат не имеет дробных знаков, а все возможные положительные значения
' имеют соответствующие метки.
'
' Если на момент экспорта в SPSS включено взвешивание, весовая переменная будет соответственно
' обозначена при экспорте в Triple-S. Это единственная новая опция версии 1.2 Triple-S, которая учтена
' в экспортирующем скрипте. Для отключения этой опции и экспорта в версию 1.1, измените значение константы
' Tripe_SVersion ниже на 1.1.
' Triple-S требует, чтобы весовая переменная была экспортирована как quantities, так что если весовая
' переменная по прочим признакам идентифицируется как Single, она всё же будет экспортирована как помеченная
' (labelled) Quantity-переменная. Это примечание, опять же, будет содержаться в схеме данных, в последнем столбце.
'
' Поскольку назначение создаваемых файлов - экспорт в другую программу, инструкция
' DOCTYPE в XML-файле выводится закомментированной.
'
' За более подробной информацией о стандарте обмена данными обследований Triple-S и прочих
' стандартах обращайтесь к веб-сайту Triple-S: www.triple-s.org
'
' Тема : Экспорт в Triple-S
' Версия : 1.1
' Автор : Chris Johnson
' Компания : Merlinco Ltd, Лондон, Великобритания
' Веб-сайт : www.merlinco.co.uk
' Дата : 22 октября 2002 года
' Протестировано в: SPSS 11.0

' Обновления после версии 1.0 (3 октября 2002)
'
' Версия 1.1
'
' 1) добавлен код для поддержки отрицательных и нулевых меток значений (Value Labels).


'Перевод: А. Балабанов, 17.01.2009.
'Проверено: SPSS 15.0.
'Размещение: http://www.spsstools.ru/Scripts/ImportExport/Export2Triple-S.txt (.sbs).

Sub Main()
   'On Error GoTo EndOfSub
'Следующие 2 строки комментируются при использовании скрипта в SPSS .sbs-файле (они нужны для разработки в Visual Studio)
   'Dim objSpssApp As spsswin.Application
   'Set objSpssApp = GetObject(, "SPSS.Application")

'Объявление переменных
   Const Triple_SVersion As Double =1.2      ' Исправьте с 1.2 на 1.1 для совместимости с версией 1.1 Triple-S.
   Dim bSuccess                              ' "Истина", если экспорт завершился удачно
   Dim bUserCancelled                        ' "Истина", если пользователь отменил диалог с запросом пути к папке
   Dim sExportTo                             ' Хранит путь к папке назначения экспорта

   Dim objSpssData As ISpssDataDoc           ' Хранит ссылку на текущий документ данных SPSS
   Dim objSpssOutputDoc As ISpssOutputDoc    ' Хранит ссылку на текущий документ результатов SPSS
   Dim Index As Long                         ' Хранит индекс обрабатываемой переменной
   Dim NumVars As Long                       ' Хранит число переменных
   Dim NumCases As Long                      ' Хранит число наблюдений
   Dim pNames As Variant                     ' Массив для хранения имен переменных
   Dim pLabels As Variant                    ' Массив для хранения меток переменной
   Dim pMsmtLevels As Variant                ' Массив для хранения типа шкалы переменных
   Dim pLabelCounts As Variant               ' Массив для хранения числа меток значений у каждой переменной
   Dim pTypes As Variant                     ' Массив для хранения типов переменных
   Dim pFormats As Variant                   ' Массив для хранения форматов переменных
   Dim pWidths As Variant                    ' Массив для хранения размеров переменных (width)
   Dim pFracs As Variant                     ' Массив для хранения число десятичных знаков у переменной
   Dim pColumnWidths As Variant              ' Массив для хранения ширины колонки переменной
   Dim pJust As Variant                      ' Массив для хранения выравнивания у переменных
   Dim pValLabels As Variant				 ' Массив для хранения меток значений переменных
   Dim pValues As Variant                    ' Массив для хранения значений, ассоциированных с метками значений

   Dim startTime As Date                     ' Хранит время начала выполнения процедуры
   Dim stopTime As Date                      ' Хранит время окончания выполнения процедуры

   Dim currIndent As String					 ' Хранит символ отступа (TAB)
   Dim Options As String                     ' Для хранения различных опций XML
   Dim IsSingle As Boolean                   ' Для хранения признака, что тип переменной - Single
   Dim isCharacter As Boolean                ' Для хранения признака, что тип переменной - Character
   Dim isQuantity As Boolean                 ' Для хранения признака, что тип переменной - Quantity
   Dim currPos As Long                       ' Хранит текущую позицию начала данных
   Dim WtVar As String 						 ' Хранит имя переменной взвешивания, если есть
   Dim Range_Min As String					 ' Для хранения минимального значения переменной типа Quantity
   Dim Range_Max As String                   ' Для хранения максимального значения переменной типа Quantity
   Dim objOutputItems As ISpssItems
   Dim objOutputItem As ISpssItem
   Dim sComment As String					 ' Хранит SPSS-форматы для переменных, экспортированных в тип Character
   Dim WeightVar As Boolean					 ' Признак того, что некоторая переменная использована для взвешивания
   Dim NumNeg As Long
   Dim NegativeValues As Boolean
'ставим ссылку на текущий документ данных SPSS
   Set objSpssData = objSpssApp.Documents.GetDataDoc(0)
'Если пользователь передал в скрипт параметр с путём для экспорта, используем его. Иначе - запрашиваем у пользователя через диалог.
   sExportTo = objSpssApp.ScriptParameter (0)
   If Len(sExportTo) = 0 Then
      Dim sDefaultPath As String
      sDefaultPath = Left(objSpssData.GetDocumentPath,Len(objSpssData.GetDocumentPath)-4) & "_SSS.xml"
      sExportTo = InputBox("Введите путь назначения экспорта:","Экспорт из SPSS в Triple-S",sDefaultPath)
'Проверка, на нажал ли пользователь "Отмена". Если нажал, аккуратно выходим из процедуры.
      If Len(sExportTo) = 0 Then
      	bUserCancelled = True
      	GoTo EndOfSub
      End If
   End If
'Начало процесса
   startTime = Now()
' Ставим ссылку на документ назначенного окна результатов
    If objSpssApp.Documents.OutputDocCount = 0 Then ' открываем новое окно, если ещё нет открытых.
       Set objSpssOutputDoc=objSpssApp.NewOutputDoc
    Else '...а если есть - ставим на него ссылку
       Set objSpssOutputDoc=objSpssApp.Documents.GetOutputDoc(0)
    End If
    objSpssOutputDoc.Visible=True
    Set objOutputItems = objSpssOutputDoc.Items
    If objOutputItems.Count()=0 Then
      Set objOutputItem = objOutputItems.GetItem(objOutputItems.Count())
    Else
      Set objOutputItem = objOutputItems.GetItem(objOutputItems.Count()-1)
    End If
    objOutputItem.Current=True
' Добавляем новый элемент в выдачу, определяем его метку и заголовок
    objSpssOutputDoc.InsertHeading("Triple-S v" & Format(Triple_SVersion,"0.0") & " Экспорт")
    Set objOutputItem = objOutputItems.GetItem(objOutputItems.Count()-1)
    objOutputItem.Current=True
    objSpssOutputDoc.Promote
    objSpssOutputDoc.InsertTitle("Title","Triple-S v" & Format(Triple_SVersion,"0.0") & " Экспорт")
'Загрузка информации о переменных в окне данных SPSS
    Call objSpssData.GetVariableInfo(pNames, pLabels, pTypes, pMsmtLevels, pLabelCounts)
    Call objSpssData.GetVariableFormats(pFormats, pWidths, pFracs)
'Определяем число переменных
   NumVars = objSpssData.GetNumberOfVariables
' проверка существования весовой переменной
   If Triple_SVersion >= 1.2 Then ' проверка, экспортируем ли в версию Triple-S не ниже 1.2
     WtVar=objSpssData.GetWeightingVariable(False)
   Else
     WtVar=""
   End If

' открываем файл для вывода xml
   Open sExportTo For Output As #1
' открываем журнальный файл и записываем заголовки
   Open Left(sExportTo,Len(sExportTo)-4) & ".lst" For Output As #2
   Print #2,"Схема экспорта данных в Triple-S для " & Left(sExportTo,Len(sExportTo)-4) & ".DAT"
   Print #2
   Print #2,"ПЕРЕМ.  " & vbTab & "ТИП " & vbTab & "ШИРИНА" & vbTab & "НАЧ.    " & vbTab & "КОНЕЦ   " & vbTab & "ФОРМАТ  " & vbTab & "КОММЕНТ. "
   Print #2,"--------" & vbTab & "----" & vbTab & "------" & vbTab & "-----   " & vbTab & "------  " & vbTab & "------  " & vbTab & "-------  "

' запись заголовочной информации sss
   Call WriteSSSHeader(1,Triple_SVersion)
' запись комментария для обозначения исходных данных
   Call writeCommentElement(1,"Triple-S v" & Format(Triple_SVersion,"0.0") & " Экспорт файла данных SPSS " & objSpssData.GetDocumentPath,currIndent)
' открываем элемент survey
Call WriteOpenElement(1,"survey","",currIndent)
' открываем элемент record
   Call WriteOpenElement(1,"record"," ident=""A""",currIndent)
' начало обработки переменных файла данных SPSS
   currPos=1
   For i=0 To NumVars-1
'инициализация переменных
     WeightVar=False
     Options=""
     IsSingle = False
     isCharacter=False
     isQuantity=False
' определим тип переменной
     Select Case pFormats(i)
       Case  SpssPrintFormatF ' обработка только числовых F-форматов, все прочие обрабатываются как строковые
         If pLabelCounts(i) = 0 Then ' если нет меток значений, экспортируем как Quantity
           Options=" ident=""" & Format(i+1,"0") & """ type=""quantity"""
           isQuantity=True
         Else ' определены метки значений, тип - Single
           IsSingle=True
           Options=" ident=""" & Format(i+1,"0") & """ type=""single"""
' теперь обрабатываем метки значений, и проверяем, нет ли меток для неположительных чисел
' загружаем все метки
           Call objSpssData.GetVariableValueLabels (i, pValues, pValLabels)
' для каждой метки
           NumNeg=0
           NegativeValues=False
           For K=0 To pLabelCounts(i)-1
             If Len(pValLabels(k))=0 Then
               pValLabels(k)=Str(pValues(k))
             End If
' отлов отрицательных значений
             If pValues(k) <=0 Then
               If pValues(k) <> 0 Then
                 NumNeg=NumNeg+1
               End If
               NegativeValues=True
             End If
           Next k
           If pFracs(i) <> 0 Or (NegativeValues And NumNeg >= 1 ) Or (NegativeValues And pLabelCounts(i)=1) Then ' особые случаи - не можем экспортировать как Single, экспортируем как Quantity
' обрабатываем как Single, но экспортируем в тип Quantity
             Options=" ident=""" & Format(i+1,"0") & """ type=""quantity"""
             isQuantity=True
           End If
         End If
' проверка на то, не является ли переменная весовой
         If  pNames(i)=WtVar Then ' если да, то добавляем к опциям информацию о взвешивании
           Options=" ident=""" & Format(i+1,"0") & """ type=""quantity"""
           Options=Options & " use=""weight"""
' она также должа быть экспортирована в Quantity, даже если она подходит под тип Single
           isQuantity=True
           WeightVar=True
         End If
       Case Else ' переменные прочих типов экспортируются в символьный тип
         Options=" ident=""" & Format(i+1,"0") & """ type=""character"""
         isCharacter = True
       End Select
' открываем элемент variable (начинается запись информации о переменной)
       Call WriteOpenElement(1,"variable",Options,currIndent)
' записываем элемент name
       Call WriteFullElement(1,"name",Trim(pNames(i)),"",currIndent)
       If pLabels(i)="" Then
         pLabels(i)=pNames(i)
       End If
' записываем элемент label
       Call WriteFullElement(1,"label",Trim(pLabels(i)),"",currIndent)
' вычисляем позицию
       Options=" start=""" & Format(currPos,"0") & """"
       If pWidths(i) <> 1 Then
         Options=Options & " finish=""" & Format(currPos+pWidths(i)-1,"0") & """"
       End If
' записываем элемент position
       Call WriteFullElementShort(1,"position",Options,currIndent)
       Options=""
       If isCharacter Then
' записываем в схему данных информацию для символьных переменных
         Call WriteLog(2,Format(pNames(i)),"C",Format(pWidths(i),"0"),Format(currPos,"0"),Format(currPos+pWidths(i)-1,"0"),"A" & Format(pWidths(i),"0") ,GetFormats(pFormats(i)))
' записываем элемент size
         Call WriteFullElement(1,"size",Format(pWidths(i),"0"),"",currIndent)
       End If
       If Not isCharacter Then
' открываем элемент values
         Call WriteOpenElement(1,"values","",currIndent)
         If isQuantity Then' т.к. тип - Quantity, печатаем размах значений (элемент range)
           Call getMin_MaxVal(pWidths(i),pFracs(i),Range_Min,Range_Max)
           Options=" from=""" & Range_Min & """ to=""" & Range_Max & """"
' записываем элемент range
           Call WriteFullElementShort(1,"range",Options,currIndent)
         End If

         If IsSingle Then
' для каждой метки...
           For K=0 To pLabelCounts(i)-1
             fmt="0"
             If pFracs(i) > 0 Then
' устанавливаем формат вывода значений
               fmt="0." & String$(pFracs(i),"0")
             End If
' записываем элемент value
' особый случай, когда тип Single, но присутствует только одна метка, и та - для нулевого значения
             If pValues(k)=0 And Not isQuantity And NegativeValues Then ' записываем как комментарий
               Call writeCommentElement(1,"value code=""" & Format(pValues(k),fmt) & """ " & pValLabels(k) & " /value",currIndent)
             Else
               Call WriteFullElement(1,"value",pValLabels(k)," code=""" & Format(pValues(k),fmt) & """",currIndent)
             End If
           Next k
         End If
' закрываем элемент values
         Call WriteCloseElement(1,"values",currIndent)
' записываем в схему данных информацию для числовых переменных
         If IsSingle And Not isQuantity Then
           If Not NegativeValues Then
             Call WriteLog(2,Format(pNames(i)),"S",Format(pWidths(i),"0"),Format(currPos,"0"),Format(currPos+pWidths(i)-1,"0"),"F" & Format(pWidths(i),"0") &  "."  & Format(pFracs(i),"0"),"")
           Else ' особый случай - одна метка, для нуля
             Call WriteLog(2,Format(pNames(i)),"S",Format(pWidths(i),"0"),Format(currPos,"0"),Format(currPos+pWidths(i)-1,"0"),"F" & Format(pWidths(i),"0") &  "."  & Format(pFracs(i),"0"),"zero-value")
           End If
         End If
         If IsSingle And isQuantity Then
           If WeightVar Then
             Call WriteLog(2,Format(pNames(i)),"Q",Format(pWidths(i),"0"),Format(currPos,"0"),Format(currPos+pWidths(i)-1,"0"),"F" & Format(pWidths(i),"0") &  "."  & Format(pFracs(i),"0"),"weight-labelled")
           Else
             Call WriteLog(2,Format(pNames(i)),"Q",Format(pWidths(i),"0"),Format(currPos,"0"),Format(currPos+pWidths(i)-1,"0"),"F" & Format(pWidths(i),"0") &  "."  & Format(pFracs(i),"0"),"labelled")
           End If
         End If
         If isQuantity And Not IsSingle Then
           If WeightVar Then
             Call WriteLog(2,Format(pNames(i)),"Q",Format(pWidths(i),"0"),Format(currPos,"0"),Format(currPos+pWidths(i)-1,"0"),"F" & Format(pWidths(i),"0") &  "."  & Format(pFracs(i),"0"),"weight")
           Else
             Call WriteLog(2,Format(pNames(i)),"Q",Format(pWidths(i),"0"),Format(currPos,"0"),Format(currPos+pWidths(i)-1,"0"),"F" & Format(pWidths(i),"0") &  "."  & Format(pFracs(i),"0"),"")
           End If
         End If
       End If
' закрываем элемент variable
       Call WriteCloseElement(1,"variable",currIndent)
' увеличение счётчика с текущим столбцом
       currPos=currPos+pWidths(i)
     Next i
' закрываем элемент record
    Call WriteCloseElement(1,"record",currIndent)
' закрываем элемент survey
    Call WriteCloseElement(1,"survey",currIndent)
' закрываем элемент sss
    Call WriteCloseElement(1,"sss","")
' закончили записывать SSS xml
' теперь - экспорт данных с использованием синтаксиса SPSS - для файла данных - тот же префикс, что и для XML, но расширение - .DAT
    strCommand="WRITE OUTFILE='" & Left(sExportTo,Len(sExportTo)-4) & ".DAT' NoTable/ all."
    strcommand=strcommand & vbCrLf & "Execute."
' выполнение команды экспорта
    objSpssApp.ExecuteCommands strCommand, False ' используем асинхронный вариант соисполнения синтаксиса и скрипта
	Do
      DoEvents
    Loop Until Not objSpssApp.IsBusy ' обрабатываем асинхронное соисполнение (эффективный вариант синхронизации)
' окончание экспорта, ставим признак успешного завершения
    bSuccess = True

EndOfSub:
   'выгружаем объекты из памяти, закрываем открытые файлы
    On Error Resume Next
    Set objSpssApp = Nothing
    Close #1
    Close #2
    On Error GoTo 0

    If bSuccess = True Then
      objSpssOutputDoc.Visible=True
 ' вставляем схему данных в документ Output (окно выдачи)
      SendKeys "%IF~" & Left(sExportTo,Len(sExportTo)-4) & ".lst" & "~" ,True ' вставка текстового файла ('в ранних версиях может потребоваться использовать "%IX~" - примеч. перев.)
      stopTime = Now()
   	  sMsg = "Файл успешно экспортирован в " & sExportTo & vbCrLf & "(Это заняло " & Format((stopTime - startTime), "nn:ss") & ")" & vbCrLf & " Данные сохранены в " & Left(sExportTo,Len(sExportTo)-4) & ".DAT"
   	  MsgBox sMsg,,"Экспорт из SPSS в Triple-S"
    Else
   	  If bUserCancelled = False Then MsgBox "Возникли проблемы! Экспорт не завершён.",,"Экспорт из SPSS в Triple-S"
    End If
End Sub
Sub WriteSSSHeader(Fn As Integer,Triple_SVersion As Double)
' запись заголовочной части для triple-s
   Dim tempIndent As String
   Print #Fn , "<?xml version=""1.0""?>"
   Print #Fn
' запись элемента doctype в виде комментария
   Call writeCommentElement(Fn,"DOCTYPE sss PUBLIC ""-//triple-s//DTD Survey Interchange v" & Format(Triple_SVersion,"0.0") &"//EN"" ""http://www.triple-s.org/dtd/sss_v" & Format(Triple_SVersion*10,"0") & ".dtd""",tempIndent)
' если хотите проверить валидность создаваемого при экспорте XML-кода, используйте следующую строку вместо предыдущей (это требует доступа в интернет)
'   Call WriteOpenElement(Fn,"!DOCTYPE", "sss PUBLIC ""-//triple-s//DTD Survey Interchange v" & Format(Triple_SVersion,"0.0") &"//EN"" ""http://www.triple-s.org/dtd/sss_v" & Format(Triple_SVersion*10,"0") & ".dtd""",tempIndent)
   Print #Fn
' стандарты именования в SPSS немного отличаются от стандартов в SSS - SPSS допускает символы '_.&$#' в именах переменных
'  Call WriteOpenElement(Fn,"sss"," version=""" & format(Triple_SVersion,"0.0") & """ options=""standardnames""",tempIndent)
   Call WriteOpenElement(Fn,"sss"," version=""" & Format(Triple_SVersion,"0.0")& """",tempIndent)
   Print #Fn
   Call WriteFullElement(Fn,"date",Format(Date,"dd-mmmm-yyyy"),"","")
   Call WriteFullElement(Fn,"time",Format(Time,"hh:nn:ss"),"","")
   Call WriteFullElement(Fn,"origin","SPSS Script Export2Triple-S v1.1 - SPSS for Windows","","")
End Sub
Sub WriteFullElement(Fn As Integer,tag As String,contents As String,Options As String,currIndent As String)
' записывает элемент целиком в 1 строку; содержимое "вычищается" с помощью функции TextClean
   Print #Fn,currIndent & "<" & tag & Options & ">" & TextClean(contents) & "</" & tag & ">"
End Sub
Sub WriteFullElementShort(Fn As Integer,tag As String,Options As String,currIndent As String)
' записываем элемент без содержания на одной строчке
   Print #Fn,currIndent & "<" & tag & Options & "/>"
End Sub
Sub WriteOpenElement(Fn As Integer,tag As String,Options As String,currIndent As String)
' записываем открывающий элемент с опциями
   Print #Fn,currIndent & "<" & tag & Options & ">"
' увеличиваем отступ (для создания визуальной структуры)
   currIndent=currIndent & vbTab
End Sub
Sub WriteCloseElement(Fn As Integer,tag As String,currIndent As String)
' переходим на предыдущий уровень отступа
   If Len(currIndent)>0 Then
     currIndent=Left(currIndent,Len(currIndent)-1)
   End If
' запись закрывающего элемента
   Print #Fn,currIndent & "</" & tag & ">"
End Sub
Sub WriteCommentElement(Fn As Integer,contents As String,currIndent As String)
' записывает элемент комментария, перед этим удаляет возможные символы "--" в его содержании (заменяет на "  ")
' и добавляет пробел в комментарии, заканчивающиеся на "-"
   If Mid(contents,Len(contents),1)="-" Then
     contents=contents & " "
   End If
   Print #Fn,currIndent & "<!--" & Replace(contents,"--","  ") & "-->"
' N.B. Комментарии не нужно пропускать через функцию TextCleaning - xml-комментарии могут содержать любые символы, за исключением --
End Sub
Sub getMin_MaxVal(width As Variant,dp As Variant,Range_Min As String,Range_Max As String)
   Dim work As String
' определяем минимальные и максимальные значения текущей переменной на основе её ширины (width) в
' output-формате и числа десятичных знаков
   work=String$(width,"9")
   Range_Max=work
   If width = 1 Then
     Range_Min="0"
   Else
     Range_Min="-" & Left(work,Len(work)-1)
   End If
   If dp > 0 Then
     Range_Min=Left(Range_Min,width-dp-1) & "." & String$(dp,"9")
     Range_Max=Left(Range_Max,width-dp-1) & "." & String$(dp,"9")
   End If
End Sub
Sub WriteLog(Fn As Integer,string1 As String,string2 As String,string3 As String,string4 As String,string5 As String,string6 As String,string7 As String)
' запись отформатированных строк в схему данных
   string1= PadtoLen(string1,8)
   string2= PadtoLen(string2,4)
   string3= PadtoLen(string3,5)
   string4= PadtoLen(string4,8)
   string5= PadtoLen(string5,8)
   string6= PadtoLen(string6,8)
   Print #Fn,string1 & vbTab & string2 & vbTab & string3 & vbTab & string4 & vbTab & string5 & vbTab & string6 & vbTab & string7
End Sub
Function PadtoLen(InString As String,maxlen As Integer) As String
' обрезаем/дополняем пробелами строки для достижения фиксированной длины
   Dim i
   i=Len(InString)
   If i < maxlen Then
     PadtoLen=InString & String(maxlen-i," ")
   Else
     PadtoLen=Left(InString,maxlen)
   End If
End Function
Function GetFormats(FormatCode As Variant) As String
' создаёт строку, указывающую на print-формат текущей переменной (для числовых форматов, отличных от F)
   Select Case FormatCode
     Case	SpssPrintFormatA
       GetFormats="" ' строковый формат, ok
     Case	SpssPrintFormatAhex
       GetFormats="hex"
     Case	SpssPrintFormatComma
       GetFormats="comma"
     Case	SpssPrintFormatDollar
       GetFormats="dollar"
     Case	SpssPrintFormatF
       GetFormats="" ' числовой формат, ok
     Case	SpssPrintFormatIb
       GetFormats="binary"
     Case	SpssPrintFormatPibhex
       GetFormats="binary"
     Case	SpssPrintFormatP
       GetFormats="binary"
     Case    SpssPrintFormatPib
       GetFormats="binary"
     Case	SpssPrintFormatPk
       GetFormats="binary"
     Case	SpssPrintFormatRb
       GetFormats="binary"
     Case	SpssPrintFormatRbhex
       GetFormats="binary"
     Case	SpssPrintFormatZ
       GetFormats="zoned"
     Case	SpssPrintFormatN
       GetFormats="integer"
     Case	SpssPrintFormatE
       GetFormats="sci not"
     Case	SpssPrintFormatDate
       GetFormats="date"
     Case	SpssPrintFormatTime
       GetFormats="time"
     Case	SpssPrintFormatDatetime
       GetFormats="datetime"
     Case	SpssPrintFormatAdate
       GetFormats="date"
     Case	SpssPrintFormatJdate
       GetFormats="date"
     Case	SpssPrintFormatDtime
       GetFormats="time"
     Case	SpssPrintFormatWkday
       GetFormats="date"
     Case	SpssPrintFormatMonth
       GetFormats="date"
     Case	SpssPrintFormatMoyr
       GetFormats="date"
     Case	SpssPrintFormatQyr
       GetFormats="date"
     Case	SpssPrintFormatWkyr
       GetFormats="date"
     Case	SpssPrintFormatPct
       GetFormats="percent"
     Case	SpssPrintFormatDot
       GetFormats="dot"
     Case	SpssPrintFormatCca
       GetFormats="currency"
     Case	SpssPrintFormatCcb
       GetFormats="currency"
     Case	SpssPrintFormatCcc
       GetFormats="currency"
     Case	SpssPrintFormatCcd
       GetFormats="currency"
     Case	SpssPrintFormatCce
       GetFormats="currency"
     Case	SpssPrintFormatEdate
       GetFormats="date"
     Case	SpssPrintFormatSdate
       GetFormats="date"
     Case Else ' неизвестный формат; просто помечаем как неизвестный (unknown)
       GetFormats="unknown"
   End Select
End Function
Function TextClean(InString As String) As String
' вычищает из строки все символы с кодами вне интервала 32-127 (заменяет на коды) и прочие спецсимволы
   Dim i As Long
   Dim iLen As Long
   Dim TextVal As Integer
   TextClean=""
   iLen=Len(InString)
   For i=1 To iLen
     TextVal=Asc(Mid(InString,i,1))
     Select Case TextVal
       Case 0 To 31
         TextClean=TextClean & "&#"  & Format(TextVal,"0") & ";"
       Case 34
         TextClean=TextClean & "&quot;"
       Case 38
         TextClean=TextClean & "&amp;"
       Case 39
         TextClean=TextClean & "&apos;"
       Case 60
         TextClean=TextClean & "&lt;"
       Case 62
         TextClean=TextClean & "&gt;"
       Case 127
         TextClean=TextClean & "<br/>"
       Case 128 To 255
         TextClean=TextClean & "&#"  & Format(TextVal,"0") & ";"
	   Case Else ' ok: в нужном интервале кодов (32-127) без спецсимволов - т.е. просто добавляем очередной проверенный символ
         TextClean=TextClean & Chr(TextVal)
     End Select
   Next i
End Function
Related pages

...

Navigate from here