'scripts_ApplyStringLength.sbs ' "Template.sav" and "Other file.sav" have numeric and string variables 'This script works with string variables having same name in both files but 'different length. 'The script asks the user to browse to the "Template sav" file, then to the "Other file.sav" ' The script changes the format of every string variable in "Other file.sav" to ' that of the corresponding string variable of "Template.sav". ' WARNING: Data may be loss if string variables ' in "Other file.sav" are longer than those in "Template.sav" ' Raynald Levesque 2003/06/15 Option Explicit Sub Main() Dim strCmdOtherFile As String Dim StrCmd As String 'Ask user to select Template.sav Call GetFile("Select Template.sav file", StrCmd) Call GetInfo("info from template") 'Ask user to select the other file.sav Call GetFile("Select the file to be modified.sav file" ,strCmdOtherFile) Call GetInfo("info from other file") Call ReformatStringVars(strCmdOtherFile) End Sub Sub GetFile(strTitle As String ,StrCmd As String ) 'Get file path from user then GET FILE Dim strFPath As String strFPath=GetFilePath("*.sav", "sav", , strTitle,0) If strFPath ="" Then 'User cancelled dialog box Exit Sub Else 'Get the file StrCmd = "GET FILE='" & strFPath & "'." & vbCrLf StrCmd = StrCmd & "EXECUTE." & vbCrLf objSpssApp.ExecuteCommands StrCmd , True End If End Sub Sub GetInfo(strTxtName As String) ' Save name and format of string variables into the text file strTxtName. Dim objDataDoc As ISpssDataDoc Dim objDocuments As ISpssDocuments ' Declare variables to receive the variable information. Dim numVars As Long Dim vrtVarNames As Variant, vrtVarLabels As Variant, vrtVarTypes As Variant Dim vrtMsmtLevels As Variant, vrtLabelCounts As Variant Dim strFPath As String Dim lngCnt As Long 'loop counter Dim StrCmd As String Set objDocuments = objSpssApp.Documents Set objDataDoc=objDocuments.GetDataDoc(0) numVars = objDataDoc.GetVariableInfo(vrtVarNames, vrtVarLabels, _ vrtVarTypes, vrtMsmtLevels, vrtLabelCounts) Debug.Clear Open "c:\\temp\\"& strTxtName & ".txt" For Output As #1 For lngCnt = 0 To numVars -1 'Debug.Print x & " " & vrtVarNames(lngCnt) & " " & vrtVarTypes(lngCnt) If vrtVarTypes(lngCnt) > 0 Then 'This is a string variable Print #1,vrtVarNames(lngCnt); vrtVarTypes(lngCnt) End If Next Close #1 End Sub Sub ReformatStringVars(strFileCmd As String) ' Read format of string variables of Template and Other file, ' write syntax file to combine the txt files into a sav file, then write syntax ' to reformat Other File. Dim StrCmd As String 'Save template information into a sav file. StrCmd = StrCmd &"DATA LIST FILE='c:\\temp\\info from template.txt' LIST /vname(A8) vlength(F3)." & vbCrLf StrCmd = StrCmd &"COMPUTE template=1." & vbCrLf StrCmd = StrCmd &"SORT CASES BY vname." & vbCrLf StrCmd = StrCmd &"SAVE OUTFILE='c:\\temp\\info temp.sav'." & vbCrLf 'Save info of other file in sav file, combine the 2 sav files StrCmd = StrCmd &"DATA LIST FILE='c:\\temp\\info from other file.txt' LIST /vname(A8) vlength(F3)." & vbCrLf StrCmd = StrCmd &"COMPUTE template=0." & vbCrLf StrCmd = StrCmd &"SORT CASES BY vname." & vbCrLf StrCmd = StrCmd &"MATCH FILES FILE='c:\\temp\\info temp.sav'" & vbCrLf StrCmd = StrCmd &" /RENAME (vlength = vtarget)" & vbCrLf StrCmd = StrCmd &" /FILE=*" & vbCrLf StrCmd = StrCmd &" /BY=vname." & vbCrLf StrCmd = StrCmd &"EXECUTE." & vbCrLf 'Write syntax to reformat string variables StrCmd = StrCmd &"SELECT IF vtarget<>vlength." & vbCrLf StrCmd = StrCmd &"STRING nformat(A4)." & vbCrLf StrCmd = StrCmd &"COMPUTE nformat=CONCAT('A',LTRIM(STRING(vtarget,F3)))." & vbCrLf StrCmd = StrCmd &"WRITE OUTFILE='c:\\temp\\syntax.sps'" & vbCrLf StrCmd = StrCmd &" /'STRING temp1234('nformat').'" & vbCrLf StrCmd = StrCmd &" /'COMPUTE temp1234='vname'.'" & vbCrLf StrCmd = StrCmd &" /'MATCH FILES FILE=* /DROP='vname'.'" & vbCrLf StrCmd = StrCmd &" /'RENAME VARIABLE (temp1234='vname').'." & vbCrLf StrCmd = StrCmd &"EXECUTE." & vbCrLf StrCmd = StrCmd &"GET FILE='c:\\temp\\other file.sav'." & vbCrLf StrCmd = StrCmd &"INCLUDE 'c:\\temp\\syntax.sps'." & vbCrLf objSpssApp.ExecuteCommands (StrCmd,True) 'Get file which needs to be standardized then reformat string variables objSpssApp.ExecuteCommands (strFileCmd, True) objSpssApp.ExecuteCommands ("INCLUDE 'c:\\temp\\syntax.sps'." & vbCrLf , True) End Sub