Ошибка «индекс вне диапазона» при попытке установить вторичную стартовую страницу

Question

Не могли бы вы прочитать этот код и сообщить мне, где я ошибаюсь?

Для получения краткого обзора, я читаю HKCU MultiStringValue для вторичных стартовых страниц для домашних страниц IE и применяю свой собственный как первый элемент в списке, сохраняя пресеты пользователя как остальную часть значений.

Когда у меня есть URL и пользователя предварительно все объединенные возвращается, скрипт работает нормально, но если у меня есть только мое множество, то allURLs выдает ошибку

Subscript из диапазона

даже хотя я размещаю свой принудительный URL-адрес в allURLs(0), поэтому он не пуст и правильно инициализирован сверху.

Option Explicit 
Dim ObjName, oADSysInfo, strComputer 
Dim objReg, IE_Main, mstrValName, strFunctionIntranet, strNYHomepage, _ 
    multiStringValues(), allURLs(), itemname, a, return 
Set oADSysInfo = CreateObject("ADSystemInfo") 
Set ObjName = GetObject("LDAP://" & oADSysInfo.UserName) 
strComputer = "." 
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv") 
Const HKCU = &H80000001 
IE_Main = "Software\Microsoft\Internet Explorer\Main" 
mstrValName = "Secondary Start Pages" 

strNYHomepage = "http://www.google.com" 
strFunctionIntranet = "www.mycompany.com" 

SetHomePage 

Sub SetHomepage 
    objReg.setStringValue HKCU, IE_Main, "Start Page", strNYHomepage 

    'Reading MultiStringValue of "Secondary Start Pages" for HKCU 
    'and continuing if it has something preset. 
    return = objReg.getMultiStringValue(HKCU, IE_Main, mstrValName, multiStringValues) 

    If return = 0 Then 
     a = 0 
     'Reading all items currently set to make sure users retain 
     'their existing URLs. 
     For Each itemname In multiStringValues 
      'Only continue if any of the existing URLs DO NOT MATCH 
      'what we are enforcing as the URL. 
      If itemname <> strFunctionIntranet Then 
       WScript.Echo itemname 
       WScript.Echo "itemname is NOT equal intranet" 
       a = a + 1 
       ReDim Preserve allURLs(a) 
       allURLs(a) = itemname 
       'a = a + 1 
      End If 
     Next 

     objReg.DeleteValue HKCU,IE_Main,mstrValName 
     'Enforce our URL to always be the first item. 
     allURLs(0) = strFunctionIntranet '<<< This is the ERROR 

     'Set the new MultiStringValue registry key back. 
     objReg.setMultiStringValue HKCU, IE_Main, mstrValName, allURLs 
     WScript.echo "finished setting all secondary tabs... " 
    Else 
     strFunctionIntranet = Array(strFunctionIntranet) 
     objReg.setMultiStringValue HKCU, IE_Main, mstrValName, strFunctionIntranet 
    End If 
End Sub 
Wscript.Quit 

Answer 1

Я подозреваю, что GetMultiStringValues вызов успешен, но возвращает пустой результат. Из-за того, что петля For Each пропускается, и вы идете прямо к заявлению

allURLs(0) = strFunctionIntranet 

Однако allURLs была определена следующим образом:

Dim allURLs() 

, которая создает переменную типа Variant(), но без фактического размера , поэтому вы не можете использовать его, если только вы его не назовете ReDim. Never declare arrays that way. Всегда определять массивы с правильным размером, в вашем случае, например, так:

ReDim allURLs(0) 

Это определяет массив размера 1 (то есть массив, который может содержать один элемент), так как вы хотите, по крайней мере один URL в этом списке.

Если вам необходимо добавить дополнительные элементы в массив, изменить его размер, как это:

ReDim Preserve allURLs(UBound(allURLs)+1) 

так что вы можете добавить следующий элемент в новом последнем слоте, как это:

allURLs(UBound(allURLs)) = newvalue 

Это вам также не нужен отдельный счетчик для отслеживания размера массива.

Кроме того, если вы хотите заполнить массив в любом случае, сделайте это первым делом, а не после того, как вы поместите в него все остальное.

ReDim allURLs(0) 
... 
Sub SetHomepage 
    objReg.setStringValue HKCU, IE_Main, "Start Page", strNYHomepage 
    return = objReg.getMultiStringValue(...) 

    If return = 0 Then 
     allURLs(0) = strFunctionIntranet 
     For Each itemname In multiStringValues 
      If itemname <> strFunctionIntranet Then 
       'grow array by 1 and append itemname 
       ReDim Preserve allURLs(UBound(allURLs)+1) 
       allURLs(UBound(allURLs)) = itemname 
      End If 
     Next 

     objReg.DeleteValue HKCU, IE_Main, mstrValName 
     ... 
    Else 
     ... 
    End If 
End Sub