Короткие .por-имена — в длинные

'BEGIN DESCRIPTION
'Скрипт назначает переменным исходные ("длинные") имена.
'Предполагается, что ранее была выполнена команда Export (в файл .por), по результатам которой посредством
'OMS схема переименования из длинных имён в короткие была записана в файл формата XML.
' (см. образец в файле LongAndShortVarNames.sps)
'END DESCRIPTION

'Тема: восстановление исходных ("длинных") имён после переноса данных через .por (скрипт работает вместе с синтаксисом).
'Ключевые слова: короткие имена переменных, длинные имена, перенос данных, сохранение, portable, .por, восстановление, сокращение.
'Опубликован: 13.02.2004 в SPSSX-L, перевод: 19.06.2008.
'Автор: Jon Peck; перевод: А. Балабанов.
'Размещение: http://www.spsstools.ru/Scripts/LongNames/RenamePortShortToLong.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\\exportnamelist.xml"            ' укажите фактический путь

Const STARTPATTERN="<line>Abbreviated  Extended</line><line>Name         Name</line><line> </line>"
Const ENDPATTERN= "<line>omsend.</line>"
Const STARTLINE = "<line>"
Const ENDLINE = "</line>"

Open FILENAME For Input As #1
Line Input #1, 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))
        shortname = Left(shortlong, InStr(shortlong, " "))
        longname = Mid(shortlong, Len(shortname)+1)
        objSpssApp.ExecuteCommands("RENAME VARIABLES " & shortname & "=" & longname & ".", False)
Loop Until Left(theline, Len(ENDPATTERN)) = ENDPATTERN

exit_rename:
Close #1
Exit Sub

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