dizi kullanılarak kayıt defterine birden çok dize değeri ekleyin

Question

Kod, eski mantıkların, bir yanıt bulamadığım bir durumda düzeltilmiş ve bir hataya kadar daraltılmış çeşitli hatalar içerdiğinden, önceki gönderiden temizlenir ve değiştirilir. Şu anda, url'm yalnızca değer olarak okunduğunda ve dizi başlatılmış olsa bile, aralık dışı hatası hatası verdiğinde hata alıyorum. Kullanıcının önceden ayarlanmış öğeleri olduğunda veya tüm işlevlerde mükemmel çalışmadığı durumlarda diğer koşullar. Teşekkürler. Eğer one field too big oluşturun çünkü

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

Sizin dizisi, boş bir öğesi içeriyor.

Değişim bu satırı: bu işe

ReDim Preserve allURLs(a+1) 

:

ReDim Preserve allURLs(a)