The script expects the followingsyntax file was ran before.

 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
'RenameLongToShort.sbs
'Posted to SPSSX-List by Jon Peck on 2004/02/13

Option Explicit

Sub Main
'BEGIN DESCRIPTION
'This script presumes that a SAVE command with /NAMES has written a correspondence table to
'a file in OMS XML format.  It renames all variables with long names to short ones.
'END DESCRIPTION

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"          ' change this as appropriate

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)           'short and long name'
        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