アレイを使用して複数のマルチストリング値をレジストリに追加する

Question

古いロジックには様々なエラーがあり、1つの条件に1つのエラーに絞り込まれているので、コードは消去され、前のポストから変更されます。現在、URLが値として読み取られていて、配列が初期化されていても添字が範囲外エラーになると、現在エラーが発生します。ユーザーがプリセット項目を持っているか、またはキーが全くない場合、他の条件は完全に機能します。ありがとう。あなたはone field too bigそれを作成するため

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

あなたの配列は、空の要素が含まれています。

変更この行：この中

ReDim Preserve allURLs(a+1) 

：

ReDim Preserve allURLs(a)