'BEGIN DESCRIPTION
'Назначает всем переменным с длинными именами короткие имена.
'Предполагается, что до запуска скрипта выполнена команда SAVE с подкомандой /NAMES, которая
'записала схему переименования переменных посредством OMS в файл формата XML.
' (см. образец в файле http://www.spsstools.ru/Scripts/LongNames/LongAndShortVarNames.txt (.sps))
'END DESCRIPTION

'Тема: конвертирование длинных имён в короткие и обратно (скрипт работает вместе с синтаксисом).
'Ключевые слова: короткие имена переменных, длинные имена, перенос данных, сохранение, восстановление, сокращение.
'Опубликован: 13.02.2004 в SPSSX-L, перевод: 19.06.2008.
'Автор: Jon Peck; перевод: А. Балабанов.
'Размещение: http://www.spsstools.ru/Scripts/LongNames/RenameLongToShort.txt (.sbs)
'Проверено: SPSS 15.0.0.


Option Explicit

Sub Main


Dim theline As String
Dim shortname As String, longname As String, startloc As Long, endloc As Long
Dim shortlong As String
On Error GoTo error_rename

Const FILENAME ="c:\\temp\\namelist.xml"          ' указать фактически существующий путь

Const STARTPATTERN="<line>----------  -------------</line><line> </line>"
Const ENDPATTERN= "<line> </line>"
Const STARTLINE = "<line>"
Const ENDLINE = "</line>"

Debug.Clear
Open FILENAME For Input As #1
Line Input #1, theline
Debug.Print theline
startloc = InStr(theline, STARTPATTERN)
If (startloc = 0) Then
        GoTo exit_rename
End If

theline = Mid(theline, startloc+ Len(STARTPATTERN))

Do
        endloc = InStr(theline, ENDLINE)
        shortlong = Mid(theline, Len(STARTLINE)+1, endloc - Len(STARTLINE)-1)           'короткое и длинное имена
        theline = Mid(theline, endloc + Len(ENDLINE))
        Debug.Print theline
        shortname = Left(shortlong, InStr(shortlong, " "))
        longname = Mid(shortlong, Len(shortname)+1)
        objSpssApp.ExecuteCommands("RENAME VARIABLES " & longname & "=" & shortname & ".", False)
Loop Until Left(theline, Len(ENDPATTERN)) = ENDPATTERN

exit_rename:
Close #1
Exit Sub

error_rename:
        MsgBox(Err.Description)
        GoTo exit_rename
End Sub