hinzufügen mehrere Multi-String-Werte zur Registrierung mit Array

Question

Code wird gereinigt und von früheren Post geändert, da alte Logiken verschiedene Fehler hatten, die korrigiert und auf einen Fehler in einer Bedingung eingegrenzt wurden, auf die ich keine Antwort finden kann. Momentan wird ein Fehler angezeigt, wenn meine URL als einziger Wert gelesen wird und einen Indexfehler außerhalb des Bereichs ausgelöst wird, obwohl das Array initialisiert wurde. Andere Bedingungen, wenn der Benutzer voreingestellte Elemente oder gar keine Taste hat, funktionieren einwandfrei. Vielen Dank.

option explicit 
    'on error resume next 
    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 

         '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

Ihr Array enthält ein leeres Element, weil Sie es one field too big erstellen.

Ändern Sie diese Zeile:

ReDim Preserve allURLs(a+1) 

in diese:

ReDim Preserve allURLs(a)