"Subscript out of range" -Fehler beim Versuch, die sekundäre Startseite zu setzen

Question

Können Sie bitte diesen Code lesen und lassen Sie mich, wo ich falsch liege?

Für einen schnellen Überblick lese ich ein HKCU MultiStringValue für sekundäre Startseiten für IE-Homepages und erzwinge meine eigene als erstes Element in der Liste, während die Benutzervoreinstellungen als Rest der Werte beibehalten.

Wenn ich meine URL und Benutzer-Preset alle kombiniert zurück kommen, Skript läuft gut, aber wenn ich nur mein Set haben, die allURLs wirft einen Fehler

Index außerhalb des zulässigen Bereichs

sogar Obwohl ich meine erzwungene URL in allURLs(0) platziere, ist sie nicht leer und oben richtig initialisiert.

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

Ich würde vermuten, dass der GetMultiStringValues Aufruf erfolgreich ist, aber ein leeres Ergebnis zurückgibt. Dadurch wird die For Each Schleife übersprungen und Sie gehen direkt auf die Erklärung

allURLs(0) = strFunctionIntranet 

wurde jedoch allURLs wie folgt definiert:

Dim allURLs() 

, die eine Variable vom Typ schafft Variant(), aber ohne eine tatsächliche Größe , so können Sie es nicht verwenden, es sei denn, Sie zuerst ReDim es. Never declare arrays that way. immer definieren Arrays mit einer richtigen Größe, in Ihrem Fall zum Beispiel wie folgt aus:

ReDim allURLs(0) 

, die ein Array von Größe definiert 1 (dh ein Array, das ein Element halten kann), da Sie mindestens eine URL wollen in dieser Liste.

Wenn Sie weitere Elemente zum Array hinzufügen müssen, ändern Sie die Größe wie folgt aus:

ReDim Preserve allURLs(UBound(allURLs)+1) 

so können Sie das nächste Element in der neuen letzten Schlitz wie folgt hinzu:

allURLs(UBound(allURLs)) = newvalue 

That Außerdem benötigen Sie keinen separaten Zähler, um die Array-Größe zu verfolgen.

Wenn Sie ein Array sowieso vorab füllen möchten, tun Sie es zuerst, nicht nachdem Sie alles andere hineingelegt haben.

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