Apply String Length

 

Download as .sbs Shows as plain text

 

  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
'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
Related pages

...

Navigate from here