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
'Begin Description
' This Scripts creates a Triple-S v1.2 XML file and related data
' file from the current SPSS data file, prompting the user
' for where they would like the file created ,the default name being
' <spss_filename>_SSS.XML
' Data is exported with the same prefix as the XML file with the suffix .DAT
' A data map is also created as <XML_prefix>.LST which is then written to the current
' SPSS Output window.
' - alternatively the user can pass a parameter for where you want the XML file created
' for example: SCRIPT 'Export2Triple-S.sbs' ("C:\\My Documents\\output.xml").
'End Description

' DETAILED USER NOTES
'
' No tests are performed to see if the output files already exist - if they do
' this program will overwrite them with no warning.
'
' This program exports all variables of SPSS type Numeric as either Triple-S single
' or quantity type variables.
' All other spss variable types are exported as Triple-S character variables
' - This includes such types as Comma,Dot,N And Scientific Notation formats
' (which may contain valid numeric data) as these are not accepted as valid quantity
' formats by Triple-S.
' It is up to the user to change the print format of these variables to Numeric type
' (F format) if they wish these to be treated as non-character.
' The last column of the data map indicates the original format of non-string variables
' which have been exported as character variables.
'
' Numeric type variables are exported as Singles if
' Rule 1) The Print Format has no decimal places (i.e. is integer)
' Rule 2) And the variable has any value labels associated with it
' Rule 3) And the variable has all positive (or zero) values associated with each value label or
' All other Numeric Type variables are exported As Triple-S Type Quantity
'
' As a Zero value is not allowed in a Triple-S Single variable definition, Single variables
' with zero values are still exported as Singles, but the zero value element is exported
' as a comment - The log file will indicate this has occurred by adding the text "zero-value"
' in the last column of that single variable. If a potential Single variable has only 1
' value label which is associated with zero it will be exported as a Quantity variable
'
' If there are value labels associated with a numeric variable which has any decimal places
' in its print format it is still exported as a quantity variable but the text 'labelled' is
' added to the last column of the data map. Triple-S allows for quantity variables to be
' exported with labels associated with particular values.
' Thus it up to the user to ensure that all variables they want exported as singles have a
' print Format with no decimal places and that all possible positive values have an associated
' value label
'
' If weighting is applied to the SPSS file then the weight variable is identified in
' the Triple-S export. This is the only Triple-S version 1.2 feature included in this
' export . To turn off this feature and export as version 1.1 change the value of the
' Constant Tripe_SVersion below to 1.1
' Triple-S requires weight variables to be exported as quantities so a numeric variable
' which is formated for export as a single which is identified as a weight variable
' will be exported as a labelled quantity variable. If a weight is detected the data map
' will indicate this in the last column
'
' As this is an export implementation the reference to the DOCTYPE is output as a comment
'
' For more infomation about the Triple-S Survey Data Interchange Standard and other
' Standards please visit the Triple-S site at www.triple-s.org
'
' Title : Export2Triple-S
' Version : 1.1
' Author : Chris Johnson
' Company : Merlinco Ltd, London UK
' Website : www.merlinco.co.uk
' Date : 22nd October 2002
' Tested with : SPSS v11.0

' Updates since Version 1.0 (3rd October 2002)
'
' Version 1.1
'
' 1) Code added to handle Negative and Zero values on Value Labels

Sub Main()
   'On Error GoTo EndOfSub
'Remove the next two lines when copying into an SPSS script.sbs file - Keep them for Visual Studio
   'Dim objSpssApp As spsswin.Application
   'Set objSpssApp = GetObject(, "SPSS.Application")

'Declare Variables
   Const Triple_SVersion As Double =1.2      ' Change this from 1.2 to 1.1 to be compatible with Triple-S version 1.1
   Dim bSuccess                              ' Flag set to true if export successful
   Dim bUserCancelled                        ' Flag set to true if user hit cancel when prompted for location
   Dim sExportTo                             ' Will hold the desired export location

   Dim objSpssData As ISpssDataDoc           ' Will hold the current SPSS data document
   Dim objSpssOutputDoc As ISpssOutputDoc    ' Will hold the current SPSS Output document
   Dim Index As Long                         ' Will hold the index of the current variable
   Dim NumVars As Long                       ' Will hold the number of variables
   Dim NumCases As Long                      ' Will hold the number of cases
   Dim pNames As Variant                     ' A variant array to store the variable names
   Dim pLabels As Variant                    ' A variant array to store the variable labels
   Dim pMsmtLevels As Variant                ' A variant array to store the variable measurement levels
   Dim pLabelCounts As Variant               ' A variant array to store the number of value labels for the variable
   Dim pTypes As Variant                     ' A variant array to store the variable types
   Dim pFormats As Variant                   ' A variant array to store the variable formats
   Dim pWidths As Variant                    ' A variant array to store the variable widths
   Dim pFracs As Variant                     ' A variant array to store the number of decimal places
   Dim pColumnWidths As Variant              ' A variant array to store the column widths
   Dim pJust As Variant                      ' A variant array to store the variable alignment justifications
   Dim pValLabels As Variant				 ' A variant array to store the value labels
   Dim pValues As Variant                    ' A variant array to store the values associated with variable labels

   Dim startTime As Date                     ' Will hold the time the procedure begins
   Dim stopTime As Date                      ' Will hold the time the procedure ends

   Dim currIndent As String					 ' Will hold current indent (TAB)
   Dim Options As String                     ' Will hold various XML Options
   Dim IsSingle As Boolean                   ' Will hold whether Variable is Single
   Dim isCharacter As Boolean                ' Will hold whether Variable is Character
   Dim isQuantity As Boolean                 ' Will hold whether Variable is Quantity
   Dim currPos As Long                       ' Will hold current starting data position
   Dim WtVar As String 						 ' Will hold name of current weighting variable if any
   Dim Range_Min As String					 ' Will hold Min Value for quantity variables
   Dim Range_Max As String                   ' Will hold Max Value for quantity variables
   Dim objOutputItems As ISpssItems
   Dim objOutputItem As ISpssItem
   Dim sComment As String					 ' Will hold SPSS format of Character exported variables
   Dim WeightVar As Boolean					 ' Will hold whether a particular variable is being used for weighting
   Dim NumNeg As Long
   Dim NegativeValues As Boolean
'Grab current SPSS Data document
   Set objSpssData = objSpssApp.Documents.GetDataDoc(0)
'If user supplied optional parameter for where to output, then use it; otherwise, prompt user.
   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("Enter path to export to:","SPSS to Triple-S Exporter",sDefaultPath)
'Verify user didn't hit cancel; if they did exit sub gracefully
      If Len(sExportTo) = 0 Then
      	bUserCancelled = True
      	GoTo EndOfSub
      End If
   End If
'Begin process
   startTime = Now()
' get output document
    If objSpssApp.Documents.OutputDocCount = 0 Then ' open new output document
       Set objSpssOutputDoc=objSpssApp.NewOutputDoc
    Else
' get the current output window
       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
' Insert Heading & Title
    objSpssOutputDoc.InsertHeading("Triple-S v" & Format(Triple_SVersion,"0.0") & " Export")
    Set objOutputItem = objOutputItems.GetItem(objOutputItems.Count()-1)
    objOutputItem.Current=True
    objSpssOutputDoc.Promote
    objSpssOutputDoc.InsertTitle("Title","Triple-S v" & Format(Triple_SVersion,"0.0") & " Export")
'Load SPSS variable definitions
    Call objSpssData.GetVariableInfo(pNames, pLabels, pTypes, pMsmtLevels, pLabelCounts)
    Call objSpssData.GetVariableFormats(pFormats, pWidths, pFracs)
'Determine the number of variables
   NumVars = objSpssData.GetNumberOfVariables
' check for existence of weight variable
   If Triple_SVersion >= 1.2 Then ' only test for weighting variable if triple_s version 1.2 or greater
     WtVar=objSpssData.GetWeightingVariable(False)
   Else
     WtVar=""
   End If

' open xml output
   Open sExportTo For Output As #1
' open Log file and write headers
   Open Left(sExportTo,Len(sExportTo)-4) & ".lst" For Output As #2
   Print #2,"Triple-S Export Map for " & Left(sExportTo,Len(sExportTo)-4) & ".DAT"
   Print #2
   Print #2,"VARIABLE" & vbTab & "TYPE" & vbTab & "WIDTH" & vbTab & "START   " & vbTab & "FINISH  " & vbTab & "FORMAT  " & vbTab & "COMMENT "
   Print #2,"--------" & vbTab & "----" & vbTab & "-----" & vbTab & "-----   " & vbTab & "------  " & vbTab & "------  " & vbTab & "------- "

' write sss header info
   Call WriteSSSHeader(1,Triple_SVersion)
' write out a comment to indicate source data
   Call writeCommentElement(1,"Triple-S v" & Format(Triple_SVersion,"0.0") & " Export of SPSS data file " & objSpssData.GetDocumentPath,currIndent)
' open survey element
   Call WriteOpenElement(1,"survey","",currIndent)
' open record element
   Call WriteOpenElement(1,"record"," ident=""A""",currIndent)
' now start processing variables
   currPos=1
   For i=0 To NumVars-1
'initialise variables
     WeightVar=False
     Options=""
     IsSingle = False
     isCharacter=False
     isQuantity=False
' first determine variable type
     Select Case pFormats(i)
       Case  SpssPrintFormatF ' only treat FormatF Numerics - all other types export as string
         If pLabelCounts(i) = 0 Then ' if no value labels treat as numeric
           Options=" ident=""" & Format(i+1,"0") & """ type=""quantity"""
           isQuantity=True
         Else ' some value labels exist so type is single
           IsSingle=True
           Options=" ident=""" & Format(i+1,"0") & """ type=""single"""
' now parse through the value labels and see if any labels are for non-positive integers
' get all the value labels
           Call objSpssData.GetVariableValueLabels (i, pValues, pValLabels)
' for each label
           NumNeg=0
           NegativeValues=False
           For K=0 To pLabelCounts(i)-1
             If Len(pValLabels(k))=0 Then
               pValLabels(k)=Str(pValues(k))
             End If
' trap negative values
             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 ' special case - can't export as a single so export as a quantity
' still treat as single but set type to quantity
             Options=" ident=""" & Format(i+1,"0") & """ type=""quantity"""
             isQuantity=True
           End If
         End If
' now test for weighting
         If  pNames(i)=WtVar Then ' if this variable is the weight variable then add weight to options
           Options=" ident=""" & Format(i+1,"0") & """ type=""quantity"""
           Options=Options & " use=""weight"""
' also this must be exported as a quantity even if single
           isQuantity=True
           WeightVar=True
         End If
       Case Else ' all other variable types exported as character
         Options=" ident=""" & Format(i+1,"0") & """ type=""character"""
         isCharacter = True
       End Select
' start writing variable element
       Call WriteOpenElement(1,"variable",Options,currIndent)
' write out name element
       Call WriteFullElement(1,"name",Trim(pNames(i)),"",currIndent)
       If pLabels(i)="" Then
         pLabels(i)=pNames(i)
       End If
' write out label element
       Call WriteFullElement(1,"label",Trim(pLabels(i)),"",currIndent)
' now calc position
       Options=" start=""" & Format(currPos,"0") & """"
       If pWidths(i) <> 1 Then
         Options=Options & " finish=""" & Format(currPos+pWidths(i)-1,"0") & """"
       End If
' write out position element
       Call WriteFullElementShort(1,"position",Options,currIndent)
       Options=""
       If isCharacter Then
' write out data map info for character variables
         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)))
' write out size element
         Call WriteFullElement(1,"size",Format(pWidths(i),"0"),"",currIndent)
       End If
       If Not isCharacter Then
' open values element
         Call WriteOpenElement(1,"values","",currIndent)
         If isQuantity Then' quantity so print range element
           Call getMin_MaxVal(pWidths(i),pFracs(i),Range_Min,Range_Max)
           Options=" from=""" & Range_Min & """ to=""" & Range_Max & """"
' write out range element
           Call WriteFullElementShort(1,"range",Options,currIndent)
         End If

         If IsSingle Then
' for each label
           For K=0 To pLabelCounts(i)-1
             fmt="0"
             If pFracs(i) > 0 Then
' set up the output format for the values
               fmt="0." & String$(pFracs(i),"0")
             End If
' Write out each value element
' special case where single but not quantity and only 1 zero label code
             If pValues(k)=0 And Not isQuantity And NegativeValues Then ' write out comment
               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
' close the values element
         Call WriteCloseElement(1,"values",currIndent)
' write out data map info for numeric variables
         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 ' Special case of one zero value
             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
' close the variable element
       Call WriteCloseElement(1,"variable",currIndent)
' increment the current data column
       currPos=currPos+pWidths(i)
     Next i
' close the record element
    Call WriteCloseElement(1,"record",currIndent)
' close the survey element
    Call WriteCloseElement(1,"survey",currIndent)
' close the sss element
    Call WriteCloseElement(1,"sss","")
' finished writing SSS xml
' so now export data using SPSS syntax - Data file is same prefix as XML file with .DAT suffix
    strCommand="WRITE OUTFILE='" & Left(sExportTo,Len(sExportTo)-4) & ".DAT' NoTable/ all."
    strcommand=strcommand & vbCrLf & "Execute."
' execute the export command
    objSpssApp.ExecuteCommands strCommand, False ' uses async processing
	Do
      DoEvents
    Loop Until Not objSpssApp.IsBusy ' handles the async processing (effectively becomes synch)
' End of Process so flag as successful
    bSuccess = True

EndOfSub:
   'Release objects from memory and close open files
    On Error Resume Next
    Set objSpssApp = Nothing
    Close #1
    Close #2
    On Error GoTo 0

    If bSuccess = True Then
      objSpssOutputDoc.Visible=True
 ' insert data map file into Output Document
      SendKeys "%IF~" & Left(sExportTo,Len(sExportTo)-4) & ".lst" & "~" ,True ' insert text file
      stopTime = Now()
   	  sMsg = "File successfully exported to " & sExportTo & vbCrLf & "(It took " & Format((stopTime - startTime), "nn:ss") & " to complete)" & vbCrLf & " Data saved to " & Left(sExportTo,Len(sExportTo)-4) & ".DAT"
   	  MsgBox sMsg,,"SPSS to Triple-S Exporter"
    Else
   	  If bUserCancelled = False Then MsgBox "There was a problem! Export unsuccessful.",,"SPSS to Triple-S Exporter"
    End If
End Sub
Sub WriteSSSHeader(Fn As Integer,Triple_SVersion As Double)
' writes triple-s header information
   Dim tempIndent As String
   Print #Fn , "<?xml version=""1.0""?>"
   Print #Fn
' write out doctype element as a comment for this export implementation
   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)
' if you want to perform a valid test then use next line instead of previous - this requires access to the internet
'   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 standard naming not same as SSS standard names - almost but SPSS also allows '_.&$#' in variable names
'  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)
' prints a full element on 1 line - Contents are Cleaned using TextClean Function
   Print #Fn,currIndent & "<" & tag & Options & ">" & TextClean(contents) & "</" & tag & ">"
End Sub
Sub WriteFullElementShort(Fn As Integer,tag As String,Options As String,currIndent As String)
' prints a full element with no contents on 1 line
   Print #Fn,currIndent & "<" & tag & Options & "/>"
End Sub
Sub WriteOpenElement(Fn As Integer,tag As String,Options As String,currIndent As String)
' prints an open element with options
   Print #Fn,currIndent & "<" & tag & Options & ">"
' increment the current indent
   currIndent=currIndent & vbTab
End Sub
Sub WriteCloseElement(Fn As Integer,tag As String,currIndent As String)
' deincrement by 1 level
   If Len(currIndent)>0 Then
     currIndent=Left(currIndent,Len(currIndent)-1)
   End If
' print a closed element
   Print #Fn,currIndent & "</" & tag & ">"
End Sub
Sub writeCommentElement(Fn As Integer,contents As String,currIndent As String)
' writes a comment element - also removes any occurances of -- in contents (replaces with "  ")
' first add white space to comments ending in -
   If Mid(contents,Len(contents),1)="-" Then
     contents=contents & " "
   End If
   Print #Fn,currIndent & "<!--" & Replace(contents,"--","  ") & "-->"
' n.b. contents does not need to go through TextCleaning - xml comments can include any characters except --
End Sub
Sub getMin_MaxVal(width As Variant,dp As Variant,Range_Min As String,Range_Max As String)
   Dim work As String
' finds the maximum and minimum value for a given variable based on the width of
' its output format and the number of decimal places
   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)
' writes a formatted line to the data map
   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
' turns a variable length string into fixed length
   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
' sets a string to hold the current variable print format for non-string or numeric variable types
   Select Case FormatCode
     Case	SpssPrintFormatA
       GetFormats="" ' string format is ok
     Case	SpssPrintFormatAhex
       GetFormats="hex"
     Case	SpssPrintFormatComma
       GetFormats="comma"
     Case	SpssPrintFormatDollar
       GetFormats="dollar"
     Case	SpssPrintFormatF
       GetFormats="" ' numeric format is 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 ' an unknown format type so just mark as unknown
       GetFormats="unknown"
   End Select
End Function
Function TextClean(InString As String) As String
' cleans up all non 32-127 characters and other special characters
   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 in range 32 to 126 and not any other special character so just append the character
         TextClean=TextClean & Chr(TextVal)
     End Select
   Next i
End Function