| Date: | Fri, 10 Oct 1997 00:14:07 -0600 |
| Reply-To: | Terry Taerum <Terry.Taerum@UALBERTA.CA> |
| Sender: | "SPSSX(r) Discussion" <SPSSX-L@UGA.CC.UGA.EDU> |
| From: | Terry Taerum <Terry.Taerum@UALBERTA.CA> |
| Organization: | Taerum Research |
| Subject: | Re: Asc II Files - SPSS script program to read in any character
delimited file |
|---|
I was somewhat displeased with my effort yesterday so I tried again.
Sorry for the use of bandwidth but I suspect others might find this routine
useful.
This time it also handles string variables and doesn't have to have variable
names -
although they are useful to have.
It also allows for delimiter lengths greater than 1.
' Reads in character delimited data using SPSS script
' Use at your own risk.
' Terry.Taerum@ualberta.ca
'
' Program to read in character delimited file and produce spss system file.
' Assumes that first line has list of variables separated by the same
delimiter
' that the data is separated by. An example would be:
' height%weight%length%value
' 10%20%33%15
' 17%11%13%12
' ...
' In the file above, the delimiter used would be the percent (%) sign.
Option Explicit
Public strNotSelVar() As String
Public strSelVar() As String
Public bolString() As Boolean
Public intArrayIndex() As Integer
Public numVariables As Long
Public VarNames() As String
Public TextFileName As String
Public Delimiter As String
Public qRunJob As Boolean
Public qReadVarNames As Boolean
Sub Main
Rem This part works with the data files.
Dim objDataDoc As ISpssDataDoc
Dim objDocuments As ISpssDocuments
Set objDocuments = objSpssApp.Documents
Set objDataDoc = objDocuments.GetDataDoc(0)
objDataDoc.Visible = True
DialogGetFileInfo
If (qRunJob) Then
Open TextFileName For Input As #2
Dim LineOfText As String
Line Input #2,LineOfText
Call GetVariables(LineOfText,Delimiter,VarNames,numVariables)
DialogGetVariableInfo
If (qRunJob) Then
Call CreateSyntaxFile(VarNames,numVariables)
objDataDoc.Visible=True
End If
End If
End Sub
Sub CreateSyntaxFile(VarNames() As String, numVariables As Long)
Dim iVars As Integer
Dim lenDelimiter As Integer
lenDelimiter=Len(delimiter)
Dim FileName As String
On Error Resume Next
MkDir "C:\temp"
On Error GoTo 0
FileName="c:\temp\char.sps"
Open FileName For Output As #3
Print #3,"new file."
Print #3,"input program."
Print #3,"data list file='"+TextFileName+"'"
Print #3," /#s$(a255) ."
Print #3,"numeric #count ."
Print #3,"compute #count=#count+1 ."
If (qReadVarNames) Then
Print #3,"do if #count gt 1 ."
End If
Print #3,"string #s1(a255) ."
Print #3,"numeric #index1 to #index";Format(numVariables);" ."
Print #3,"vector indexx=#index1 to #index";Format(numVariables);"."
Print #3,"loop #i=1 to";numVariables;" ."
Print #3,"compute indexx(#i)=0 ."
Print #3,"end loop ."
For iVars=0 To numVariables-1
If (bolString(iVars)) Then
Print #3,"compute indexx(";iVars+1;")=1 ."
End If
Next
Dim vi1, vi2 As Integer
vi1=numVariables
vi2=-1
For iVars=0 To numVariables-1
If Not(bolString(iVars)) Then
If (iVars<vi1) Then
vi1=iVars
End If
If (iVars>vi2) Then
vi2=iVars
End If
Print #3,"numeric "&VarNames(iVars)&"."
End If
Next
If (vi2>=vi1) Then
Print #3,"vector vx=";VarNames(vi1);" to ";VarNames(vi2);" ."
End If
Dim si1, si2 As Integer
si1=numVariables
si2=-1
For iVars=0 To numVariables-1
If (bolString(iVars)) Then
If (iVars<si1) Then
si1=iVars
End If
If (iVars>si2) Then
si2=iVars
End If
Print #3,"string "&VarNames(iVars)&" (a8)."
End If
Next
If (si2>=si1) Then
Print #3,"vector sx=";VarNames(si1);" to ";VarNames(si2);" ."
End If
Print #3,"compute #iptx=1."
Print #3,"compute #ivar=0."
Print #3,"compute #istr=0."
Print #3,"loop #i=1 to ";numVariables;"."
Print #3,"compute #ipt=index(substr(#s$,#iptx),'"+delimiter+"') ."
Print #3,"if (#ipt<=0) #ipt=12 ."
Print #3,"compute #s1=substr(#s$,#iptx,#ipt-1) ."
Print #3,"compute #iptx=#iptx+#ipt+";lenDelimiter;"-1 ."
Print #3,"do if indexx(#i) eq 1 ."
If (si1<=si2) Then
Print #3,"compute #istr=#istr+1 ."
Print #3,"compute sx(#istr)=#s1 ."
End If
Print #3,"else ."
If (vi1<=vi2) Then
Print #3,"compute #ivar=#ivar+1 ."
Print #3,"compute vx(#ivar)=num(#s1,f12) ."
End If
Print #3,"end if ."
Print #3,"End Loop ."
Print #3,"end case ."
If (qReadVarNames) Then
Print #3,"end if ."
End If
Print #3,"end input program."
Print #3,"execute ."
Print #3,"save outfile='c:\temp\save1.sav'"
Print #3," /keep ";
For iVars=0 To numVariables-1
Print #3,VarNames(iVars);" ";
If (iVars+1 Mod 10 = 0 And iVars<numVariables-1) Then
Print #3," "
End If
Next
Print #3," ."
Print #3,"execute ."
Print #3,"get file='c:\temp\save1.sav' ."
Print #3,"execute ."
Close #3
Dim objSyntaxDoc As ISpssSyntaxDoc
Set objSyntaxDoc = objSpssApp.OpenSyntaxDoc (FileName)
objSyntaxDoc.Visible = True
objSyntaxDoc.Run
objSyntaxDoc.Close
End Sub
Sub GetVariables(LineOfText,Delimiter, VarNames() As String, numVariables As
Long)
Dim qDone As Boolean
qDone=False
Dim lngIndex, lngIpt, lngLen As Long
lngLen=Len(LineOfText)
lngIndex=1
numVariables=0
While Not qDone
lngIpt=InStr(lngIndex,LineOfText,Delimiter)
If (lngIpt>0) Then
lngIndex=lngIpt+1
numVariables=numVariables+1
ElseIf (lngIpt<=0) Then
qDone=True
If (lngLen > lngIndex) Then
numVariables=numVariables+1
End If
End If
Wend
ReDim VarNames(numVariables) As String
lngIndex=1
Dim iVars As Integer
For iVars=0 To numVariables-1
lngIpt=InStr(lngIndex,LineOfText,Delimiter)
If (lngIpt=0) Then
lngIpt=lngLen+1
End If
If (qReadVarNames) Then
VarNames(iVars)=Mid(LineOfText,lngIndex,lngIpt-lngIndex)
Else
VarNames(iVars)="Var"&Format(iVars+1)
End If
lngIndex=lngIpt+1
Next
End Sub
Sub DialogGetFileInfo
Begin Dialog UserDialog 540,203,"Read in Character Delimited
Data",.DialogFileInfo
PushButton 430, 14, 90, 21, "OK",
.cmdRun
PushButton 150, 14, 200, 21, "Click to get raw data file",
.cmdRawData
PushButton 430, 40, 90, 21, "Cancel",
.cmdCancel
Text 35, 40, 100, 14, "Text File Name:",
.txtTextFileName
TextBox 150, 40, 250, 21,
.TextFileName
CheckBox 20, 75, 240, 20, "Check box to read variable names.",
.cmdReadVarNames
Text 20, 100, 400, 14, "Choose (or enter) your
delimiter string. The default is Hash (#)", .txtDelimiter
TextBox 10, 120, 40, 21,
.Delimiter
PushButton 50, 120, 100, 21, "Hash #",
.cmdHash
PushButton 150, 120, 100, 21, "Percent %",
.cmdPercent
PushButton 250, 120, 100, 21, "Comma ,",
.cmdComma
PushButton 350, 120, 100, 21, "SemiColon ;",
.cmdSemi
PushButton 450, 120, 100, 21, "Ampersand",
.cmdAmp
PushButton 50, 145, 100, 21, "Tab",
.cmdTab
PushButton 150, 145, 100, 21, "Space",
.cmdSpace
End Dialog
Dim dlg As UserDialog
Dialog dlg
qReadVarNames=dlg.cmdReadVarNames
End Sub
Function DialogFileInfo(strDialogItem As String, intAction As Integer,
intSuppValue As Integer) As Boolean
Select Case intAction
Case 1 ' Dialog box initialization
DlgEnable "cmdCancel", True
DlgEnable "cmdRun", True
DlgEnable "cmdRawData", True
DlgEnable "cmdReadVarNames", True
DlgEnable "cmdPercent", True
DlgEnable "cmdHash",True
DlgEnable "cmdComma", True
DlgEnable "cmdSemi", True
DlgEnable "cmdAmp", True
DlgEnable "cmdTab", True
DlgEnable "cmdSpace", True
DlgText "Delimiter", "#"
Delimiter="#"
Case 2 ' Value changing or button pressed
Select Case strDialogItem
Case "cmdRun"
TextFileName=DlgText("TextFileName")
Delimiter=DlgText("Delimiter")
If TextFileName="" Then
MsgBox "Please provide a Text file for the raw data.", 48, "Character
Delimited Data File"
dialogFileInfo = True
ElseIf Delimiter="" Then
MsgBox "Please provide a delimiter.", 48, "Character Delimited Data
File"
dialogFileInfo = True
Else
dialogFileInfo = False
qRunJob=True
End If
Case "cmdCancel"
dialogFileInfo = False
qRunJob=False
Case "cmdRawData"
TextFileName=GetFilePath$(,"txt",,"Raw Data File to be read from:",0)
dialogFileInfo=True
DlgText "TextFileName", TextFileName
Case "cmdReadVarNames"
Case "cmdPercent"
Delimiter="%"
dialogFileInfo=True
DlgText "Delimiter", Delimiter
Case "cmdHash"
Delimiter="#"
dialogFileInfo=True
DlgText "Delimiter", Delimiter
Case "cmdComma"
Delimiter=","
dialogFileInfo=True
DlgText "Delimiter", Delimiter
Case "cmdSemi"
Delimiter=";"
dialogFileInfo=True
DlgText "Delimiter", Delimiter
Case "cmdAmp"
Delimiter="&"
dialogFileInfo=True
DlgText "Delimiter", Delimiter
Case "cmdTab"
Delimiter=Chr(9)
dialogFileInfo=True
DlgText "Delimiter", Delimiter
Case "cmdSpace"
Delimiter=" "
dialogFileInfo=True
DlgText "Delimiter", Delimiter
End Select
End Select
End Function
Sub DialogGetVariableInfo
ReDim strNotSelVar(0) As String
ReDim strSelVar(0) As String
Begin Dialog UserDialog 540,203,"Select String
Variables",.DialogVariableInfo
ListBox 30,28,140,119,strNotSelVar(),.lstVarInFile
ListBox 290,28,150,119,strSelVar(),.lstSelVar
PushButton 450,14,90,21,"OK",.cmdRun
PushButton 450,42,90,21,"Cancel",.cmdCancel
PushButton 172,77,116,21,">Make String>",.cmdMoveIt
Text 290,14,140,14,"String Variables",.lbl1
Text 30,14,140,14,"Numeric Variables",.lbl2
End Dialog
Dim dlg As UserDialog
Dialog dlg
End Sub
Function DialogVariableInfo(strDialogItem As String, intAction As Integer,
intSuppValue As Integer) As Boolean
Rem Note Note Note This routine is a Modified copy of an SPSS provided
script file.
Select Case intAction
Case 1 ' Dialog box initialization
DlgEnable "cmdCancel", True
DlgEnable "cmdRun", True
GetVarsFromFile 'Sub that gets the variables from file and puts in
list box
Case 2 ' Value changing or button pressed
Select Case strDialogItem
Case "cmdRun"
DialogVariableInfo = False
qRunJob=True
Case "cmdCancel"
DialogVariableInfo = False
qRunJob=False
Case "lstVarInFile"
DlgText "cmdMoveIt", ">Make String>"
DlgEnable "cmdMoveIt", True
DialogVariableInfo = True
Case "lstSelVar"
DlgText "cmdMoveIt", "<Make Numeric<"
DialogVariableInfo = True
Case "cmdMoveIt"
If DlgText("cmdMoveIt") = ">Make String>" Then
Call AddToSelList
Else
Call RemoveFromSelList
End If
DialogVariableInfo = True
End Select
End Select
End Function
Sub AddToSelList()
Rem Note Note Note This routine is a Modified copy of an SPSS provided
script file.
Dim intSelIndex As Integer
Dim i As Integer
intSelIndex = DlgValue("lstVarInFile")
For i = 0 To UBound(intArrayIndex)
If (intArrayIndex(i) = intSelIndex) And (bolString(i) = False) Then
bolString(i) = True
Exit For
End If
Next i
Call PopulateLists
End Sub
Sub RemoveFromSelList()
Rem Note Note Note This routine is a Modified copy of an SPSS provided
script file.
Dim intSelIndex As Integer
Dim i As Integer
intSelIndex = DlgValue("lstSelVar")
For i = 0 To UBound(intArrayIndex)
If (intArrayIndex(i) = intSelIndex) And (bolString(i) = True) Then
bolString(i) = False
Exit For
End If
Next i
Call PopulateLists
End Sub
Sub PopulateLists()
Rem Note Note Note This routine is a Modified copy of an SPSS provided
script file.
Dim i As Integer
Dim intNumNotSel As Integer
Dim intNumSel As Integer
intNumSel = 0
intNumNotSel = 0
ReDim strNotSelVar(intNumNotSel) As String
ReDim strSelVar(intNumSel) As String
For i = 0 To UBound(bolString)
If bolString(i) = False Then
ReDim Preserve strNotSelVar(intNumNotSel) As String
strNotSelVar(intNumNotSel) = VarNames(i)
intArrayIndex(i) = intNumNotSel
intNumNotSel = intNumNotSel + 1
Else 'Variable is selected for analysis
ReDim Preserve strSelVar(intNumSel) As String
strSelVar(intNumSel) = VarNames(i)
intArrayIndex(i) = intNumSel
intNumSel = intNumSel + 1
End If
Next i
DlgListBoxArray "lstVarInFile", strNotSelVar()
DlgListBoxArray "lstSelVar", strSelVar()
End Sub
Sub GetVarsFromFile()
Dim i As Long
ReDim bolString(NumVariables) As Boolean
ReDim intArrayIndex(NumVariables) As Integer
For i = 0 To numVariables
bolString(i) = False
intArrayIndex(i) = i
Next i
DlgEnable "lstVarInFile", True
DlgEnable "lstSelVar", True
Call PopulateLists
End Sub
|