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 freeError 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), "]", "").
3 Answers
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.
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.
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
