Subscript out of range error in VBScript script

Question

I'm trying to move my entire User folder in Windows Vista to a non-system partition. To do so with a minimum hassle I'm following the directions provided at Ben's Blog, specifically the VBScript he provides.

However executing the script throws up an error which I can't resolve myself. Here's the VBScript code followed by the text file it works from, and finally my error message. How do I correct the problem?

VBScript Code:

'# Perform dir /a c:\users > c:\dir.txt
'# place this script file in c:\ too
'# double click to run it
'# run resulting script.bat from recovery mode
repprefix = " Directory of..." ' Modify to your language
sourcedrive = "C:\"
targetdrive = "D:\"
altsourcedrive = "C:\" 'leave same as target drive unless otherwise indicated
alttargetdrive = "E:\" 'leave same as target drive unless otherwise indicated

inname = "dir.txt"
outname = "script.bat"
userroot = "Users"

set fso = CreateObject("Scripting.FileSystemObject")

' construct batch commands for saving rights, then link, the recreating rights
Function GetCommand(curroot, line, typ, keyword)
 ' first need to get source and target
 pos = Instr(line, keyword) + Len(keyword)

 tuple = Trim(Mid(line, pos))
 arr = Split(tuple, "[")

 oldtarget = Replace(arr(1), "]", "")
 oldlink = curroot & "\" & Trim(arr(0))

 ' need to determine if we are pointing back to old disk
 newlink = replace(oldlink, sourcedrive, targetdrive)
 if(Instr(oldtarget, sourcedrive & userroot)) then
     newtarget = Replace(oldtarget, sourcedrive, targetdrive)
 else
 newtarget = oldtarget ' still pointing to original target
 end if

 ' comment
 out = "echo " & newlink & " --- " & newtarget & vbCrLf
 ' save permissions
 out = out & "icacls """ & replace(oldlink, sourcedrive, altsourcedrive) & """ /L /save " & altsourcedrive & "permissions.txt" & vbCrLf

 ' create link
 newlink = replace(newlink, targetdrive, alttargetdrive)
 if typ = "junction" then
     out = out & "mklink /j """ & newlink & """ """ & newtarget & """" & vbCrLf
 else ' typ = "symlink"
     out = out & "mklink /d """ & newlink & """ """ & newtarget & """" & vbCrLf
 end if

 'set hidden attribute
 out = out & "attrib +h """ & newlink & """ /L" & vbCrLf

 ' apply permissions
 shortlink = Left(newlink, InstrRev(newlink, "\") - 1) 'icacls works strangely - non-orthogonal for restore
 out = out & "icacls """ & shortlink & """ /L /restore " & altsourcedrive & "permissions.txt" & vbCrLf

 GetCommand = out & vbCrLf
End Function

Sub WriteToFile(file, text)
 ForWriting = 2
 Create = true
 set outfile = fso.OpenTextFile(file, ForWriting, Create)
 Call outfile.Write(text)
 Call outfile.Close()
End Sub

outtext = "ROBOCOPY " & altsourcedrive & userroot & " " & alttargetdrive & userroot & " /E /COPYALL /XJ" & vbCrLf & vbCrLf

set intext = fso.OpenTextFile(inname)
while not intext.AtEndOfStream
 line = intext.ReadLine()
 if Instr(line, repprefix) then
     curroot = Replace(line, repprefix, "")
 elseif Instr(line, juncname) then
 outtext = outtext & GetCommand(curroot, line, "junction", juncname)
 elseif Instr(line, linkname) then
 outtext = outtext & GetCommand(curroot, line, "symlink", linkname)
 end if 
Wend

outtext = outtext & "icacls " & altsourcedrive & userroot & " /L /save " & altsourcedrive & "permissions.txt" & vbCrLf
outtext = outtext & "ren " & altsourcedrive & userroot & " _" & userroot & vbCrLf
outtext = outtext & "mklink /j " & altsourcedrive & userroot & " " & targetdrive & userroot & vbCrLf
outtext = outtext & "icacls " & altsourcedrive & " /L /restore " & altsourcedrive & "permissions.txt"

Call intext.Close()

Call WriteToFile(outname, outtext)

MsgBox("Done writing to " & outname)

dir.txt:

Volume in drive C is ACER
Volume Serial Number is 08D7-C0CC

Directory of c:\users

07/16/2009 12:29 PM {DIR} .
07/16/2009 12:29 PM {DIR} ..
11/02/2006 09:02 AM {SYMLINKD} All Users [C:\ProgramData]
11/02/2006 09:02 AM {DIR} Default
11/02/2006 09:02 AM {JUNCTION} Default User [C:\Users\Default]
08/21/2008 08:37 AM 174 desktop.ini
11/02/2006 08:50 AM {DIR} Public
07/19/2009 08:54 PM {DIR} Steve
1 File(s) 174 bytes
7 Dir(s) 5,679,947,776 bytes free

Error Message:

Windows Script Host

Script: C:\user location.vbs Line: 25 Char: 2 Error: Subscript out of range: '[number: 1]' Code: 800A0009 Source: Microsoft VBScript runtime error

(In the VBScript script that I'm using on my system, I believe that 'Line 25' corresponds to the line beginning with oldtarget = Replace(arr(1), "]", "").

Answer 1

Make sure that when you copy script from another page that line breaks are copied over as they should be. For example, in the script you printed above, it appears the the line that starts

pos = Instr(line, keyword) + Len(keyword)

is actually appended to the remark on the previous line (everything after the ' in that line). That could cause the problem you're having in that pos would never be set appropriately and so nothing would be copied into arr.

Just go line by line in the script you have on your computer and compare it to the version you copied from at Ben's Blog. Every line that is on it's own line MUST be on it's own line in your script file as well.

EDIT: As for what the error message means, it looks like oldTarget is trying to grab a string between two brackets. The error occurs because there's not enough text in the string to start at array position 1 (and this is zero-based, meaning that it's actually trying to get the second character in the string), i.e. it is at most a one-character string which is not possible considering that even a blank string 'element' would have two characters (the open bracket and the close bracket). So, you need to figure out why you're not getting a valid string at that point in the code to fix this problem.

Answer 2

First off, this is a very poorly written script. I would recommend rewriting it properly. It's kind of a hack job and that's where most of your problems are coming from.

Specifically, your problem occurs in the second line here:

arr = Split(tuple, "[")

oldtarget = Replace(arr(1), "]", "")

It means the that split in the line before did not return an array, meaning that the [ was not found in tuple and thus arr(1) is out of range. Try checking that arr is an array before trying to access it.

Answer 3

Except for the Jab at a beginner, I agree with Nilpo. Your issue is the 'arr(1)' is failing because the script is expecting this the second position in the array and it isn't there, which 99% of the time is an 'out of bounds' error. It may not always be in your control but that is typically a reference to an array bounds issue. Array positions start with zero. Ex. Array(0, 1, 2, 3, ...). So (1) is the second position. He is also right, it could be a lot cleaner but you wouldn't know if just starting with VBScript.

I think this is what you are looking for and it is cleaner. This will pull out the path between the brackets []. You never want to assume both brackets are there, even if it is a generated file, so I have an If/Then check for both before executing, otherwise it will skip to the next line and the end.

I did run this and it worked in capturing between the brackets. You may need to tweak some since I'm not sure exactly what you may want to see in the output. :)

Option Explicit

Dim fso : set fso = CreateObject("Scripting.FileSystemObject")
Dim fileIn : set fileIn = fso.OpenTextFile("c:\users\MyFolder\desktop\input.txt")
Dim fileOut : set fileOut = fso.OpenTextFile("c:\users\MyFolder\desktop\output.txt", 2, true) ' for writing/create
Dim line
Dim arr

Do Until fileIn.AtEndOfStream
    line = fileIn.ReadLine
    if InStr(line, "[") > 0 And InStr(line, "]") > 0 then
        arr = Split(Split(line, "[")(1), "]")

        fileOut.WriteLine arr(0) & "\"
    end if
Loop

fileIn.Close
fileOut.Close

Set fso     = Nothing
Set fileIn  = Nothing
Set fileOut = Nothing
Set line    = Nothing
Set arr     = Nothing