' Prologue: Sub start Dim text1 As String text1 = "Miss2Sys creates SPSS syntax to recode all missing values" & vbCrLf text1 = text1 & "of numeric variables of a specific SPSS data file (*.sav) to" & vbCrLf text1 = text1 & "system missing values." & vbCrLf & vbCrLf text1 = text1 & "The script creates the SPSS syntax needed to recode the" & vbCrLf text1 = text1 & "numeric variables, will run the syntax, and will save the" & vbCrLf text1 = text1 & "modified data as an SPSS data file with the extension .RSav" & vbCrLf text1 = text1 & "into the directory of the original data file." & vbCrLf & vbCrLf text1 = text1 & "If the script has finished the user has to save the SPSS syntax" & vbCrLf text1 = text1 & "(as an .sps-file) by himself." & vbCrLf & vbCrLf text1 = text1 & "WARNING: Close or save your SPSS data file before running the" & vbCrLf text1 = text1 & "script because it will not save a current data file and will" & vbCrLf text1 = text1 & "close it without a warning!" & vbCrLf Begin Dialog UserDialog 500,378,"Miss2Sys" ' %GRID:10,7,1,1 Text 40,21,410,14,"SPSS-Script to recode missing values",.text0,2 OKButton 150,336,90,21 CancelButton 260,336,90,21 Text 40,42,420,280,text1,.Text1 End Dialog Dim dlg As UserDialog Dialog dlg End Sub ' ---------------------------------------------- ' Dialogue to open SPSS file: Sub BuildDialog Begin Dialog UserDialog 580,70,"Miss2Sys",.DialogFunc Text 40,7,280,21,"SPSS data file to open:",.txtDialogTitle TextBox 40,28,340,21,.txtFilename OKButton 470,7,100,21,.cmdOK CancelButton 470,35,100,21,.cmdCancel End Dialog Dim dlg As UserDialog Dialog dlg End Sub ' ---------------------------------------------- ' Function to open file with filename specified: Function DialogFunc(strDlgItem As String, intAction As Integer, intSuppValue As Integer) As Boolean Dim FileDate As Date Select Case intAction Case 1 ' Signal at initialization of dialogue field Beep Case 2 ' Change of value or click on button Select Case strDlgItem Case "cmdOK" ' If click "OK" open file with filename specified: strFilename = DlgText("txtFilename") Call OpenDataFile(strFilename) On Error GoTo Problem FileDate = FileDateTime(strFilename) If Err > 0 Then GoTo Problem End If DialogFunc = False Case "cmdCancel" ' Close dialogue if user clicks "CANCEL": Err = 1 DialogFunc = False End Select End Select GoTo Ende Problem: MsgBox("File '" & strFilename & "' not found") Ende: End Function ' ---------------------------------------------- ' Open data file with filename specified Sub OpenDataFile(strFilename As Variant) Set DataDoc = objSpssApp.OpenDataDoc(strFilename) End Sub ' ============================================== ' Main program "Miss2Sys.sbs": Sub Main Dim DataDoc As ISpssDataDoc Dim Document As Variant Dim numVars As Long Dim VarNames As Variant Dim VarLabels As Variant Dim VarTypes As Variant Dim VarLevels As Variant Dim LabelCounts As Variant Dim NSpace As Integer Dim RecMiss AS String Dim RightFill As String Dim i,k,p As Integer Dim Delimiter As String Call start ' ---------------------------------------------- ' Open file via dialogue Call BuildDialog If Err > 0 Then GoTo ProbMsg End If Set DataDoc = objSpssApp.Documents.GetDataDoc(0) Document = DataDoc.GetDocumentPath numVars = DataDoc.GetVariableInfo(VarNames, VarLabels, VarTypes, VarLevels, LabelCounts) ' ---------------------------------------------- ' Documentation of data file: Delimiter = "*/" & vbCrLf Dim FileDate As Date Dim NCases As Long Dim FileInfo1 As String, FileInfo2 As String, FileInfo3 As String, FileInfo4 As String Dim FileInfo As String FileDate = FileDateTime(Document) NCases = DataDoc.GetNumberOfCases FileInfo0a = "/* The variables to recode to SYSMISS are taken from" FileInfo0b = "/* " FileInfo1 = "/* File: " & Document FileInfo2 = "/* Created: " & FileDate FileInfo3 = "/* Variables: " & numVars FileInfo4 = "/* Cases: " & NCases If Len(FileInfo0a) > Len(FileInfo1) Then NSpace = Len(FileInfo0a) Else NSpace = Len(FileInfo1) End If For i=Len(FileInfo0a) To NSpace FileInfo0a = FileInfo0a & " " Next FileInfo0a = FileInfo0a & Delimiter For i=Len(FileInfo0b) To NSpace FileInfo0b = FileInfo0b & " " Next FileInfo0b = FileInfo0b & Delimiter For i=Len(FileInfo1) To NSpace FileInfo1 = FileInfo1 & " " Next FileInfo1 = FileInfo1 & Delimiter For i=Len(FileInfo2) To NSpace FileInfo2 = FileInfo2 & " " Next FileInfo2 = FileInfo2 & Delimiter For i=Len(FileInfo3) To NSpace FileInfo3 = FileInfo3 & " " Next FileInfo3 = FileInfo3 & Delimiter For i=Len(FileInfo4) To NSpace FileInfo4 = FileInfo4 & " " Next FileInfo4 = FileInfo4 & Delimiter FileInfo = FileInfo0a & FileInfo0b & FileInfo1 & FileInfo2 & FileInfo3 & FileInfo4 & vbCrLf ' ---------------------------------------------- ' Recoding of missing values for numeric variables: ' Set SyntaxDoc = objSpssApp.NewSyntaxDoc ' SyntaxDoc.Visible = True Delimiter = " " RecMiss = "RECODE" p = 0 For i = 0 To numVars-1 If (VarTypes(i) = 0) Then p = p+1 RightFill = "" NSpace = Len(VarNames(i)) For k = NSpace To 7 RightFill = RightFill + " " Next RecMiss = RecMiss & Delimiter & VarNames(i) & RightFill If (p = 5) Then Delimiter = vbCrLf & " " p = 0 Else Delimiter = " " End If End If Next If RecMiss = "RECODE" Then RecMiss = "/* no numeric variables to recode */" Else RecMiss = RecMiss & vbCrLf & " (missing=sysmis)." & vbCrLf RecMiss = "GET FILE='" & Left(Document,Len(Document)-3) & "sav'." & vbCrLf & vbCrLf & RecMiss & vbCrLf RecMiss = RecMiss & vbCrLf & "SAVE OUTFILE='" & Left(Document,Len(Document)-3) & "RSav'." & vbCrLf End If RecMiss = FileInfo & RecMiss ' --------------------------------------------------- ' Write and execute syntax: objSpssApp.ExecuteCommands RecMiss, True Set spssjob = objSpssApp.NewSyntaxDoc spssjob.Visible = True spssjob.Text = RecMiss ' --------------------------------------------------- ' Epilogue: GoTo Finito ProbMsg: If Err = 1 Then MsgBox("Script cancelled by user.",0,"Miss2Sys") End If Exit Sub Finito: MsgBox("Sript run seems to be OK. Save the SPSS-syntax created!",0,"Miss2Sys") End Sub