Export to Triple-S

'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