Отформатировать длину переменных

'scripts_ApplyStringLength.sbs
' Файлы "Шаблон.sav" and "Другой файл.sav" имеют переменные числового и строгового форматов
'Данный скрипт работает со строковыми переменными из обоих файлов, которые имеют одинаковые имена,
' но разную длину.
'Скрипт предлагает пользователю указать путь к файлу "Шаблон.sav", затем - к файлу "Другой файл.sav".
' Далее скрипт меняет длину каждой строковой переменной в файле "Другой файл.sav" на длину
' соответствующей строковой переменной из файла "Шаблон.sav".
' ВНИМАНИЕ: В случае, если в файле "Другой файл.sav" строковые переменные были длиннее, чем
' в "Шаблон.sav", часть данных из них может быть потеряна!
' Автор: Raynald Levesque, 15.06.2003

' "Шаблон.sav" и "Другой файл.sav" - имена собирательные и означают имена ваших файлов.

Option Explicit

Sub Main()
	Dim strCmdOtherFile As String
	Dim StrCmd As String

	'Просим пользователя открыть файл Шаблон.sav
	Call GetFile("Откройте файл шаблона", StrCmd)
	Call GetInfo("info from template")

	'Просим пользователя открыть Другой файл.sav
	Call GetFile("Откройте файл, который будет отформатирован по шаблону" ,strCmdOtherFile)
	Call GetInfo("info from other file")

	Call ReformatStringVars(strCmdOtherFile)
End Sub

Sub GetFile(strTitle As String ,StrCmd As String )
	'Получаем путь к файлу, указанному пользователем и выполняем команду GET FILE
	Dim strFPath As String
	strFPath=GetFilePath("*.sav", "sav", , strTitle,0)
	If strFPath ="" Then	'Если пользователь нажал "Отмена"
		Exit Sub
	Else		    		'Открываем файл в SPSS
		StrCmd = "GET FILE='" & strFPath & "'." & vbCrLf
		StrCmd = StrCmd & "EXECUTE." & vbCrLf
		objSpssApp.ExecuteCommands StrCmd , True
	End If
End Sub

Sub GetInfo(strTxtName As String)
' Сохраняем имя и длину каждой строковой переменной в текстовый файл strTxtName.
	Dim objDataDoc As ISpssDataDoc
	Dim objDocuments As ISpssDocuments

	' Определим переменные, в которые будет сохранена информация о структуре файла данных.
	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	'счётчик цикла
	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)
' Читаем формат строковых переменных в файлах шаблона и другом файле данных (из созданных текстовых файлов),
' составляем файл синтаксиса, чтобы создать из двух текстовых файлов файл sav file, затем
' составляем синтаксис, чтобы отформатировать переменные в Другом файле.
	Dim StrCmd As String

	'Сохраняем информацию о переменных шаблона в файл sav.
	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

	'Сохраняем информацию о переменных Другого файла в файл sav, сливаем 2 файла sav
	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

	'Составляем синтаксис по переформатированию строковых переменных
	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
	objSpssApp.ExecuteCommands (StrCmd,True)

	'Открываем Другой файл (который должен быть отформатирован) и изменяем длину строковых переменных
	objSpssApp.ExecuteCommands (strFileCmd, True)
	objSpssApp.ExecuteCommands ("INCLUDE 'c:\\temp\\syntax.sps'." & vbCrLf , True)
End Sub