セカンダリスタートページを設定しようとすると "subscript out of range"エラーが発生する

Question

このコードを読んで、間違っている場所に教えてもらえますか？

私は、IEホームページのセカンダリスタートページのHKCU MultiStringValueを読んでおり、ユーザのプリセットを残りの値として保持しながら、リスト内の最初の項目として自分自身を強制しています。

でも、私は私のURLとユーザーの設定、すべての組み合わせ戻ってくるがある場合、スクリプトは正常に実行されますが、私はONLY鉱山が設定されている場合は、allURLsが範囲

外のエラー

添字をスローします強制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は次のように定義されたのため、次のタイプVariant()の変数を作成しますが、実際の大きさのない

Dim allURLs() 

あなたが最初にReDimを使わなければそれを使うことはできません。 Never declare arrays that way。 常にこのような場合のために、あなたのケースで、適切なサイズの配列を定義する：あなたは、少なくとも1つのURLをしたいので、

ReDim allURLs(0) 

、サイズ1（一つの要素を保持することができ、すなわち、配列）の配列を定義しますそのリストに

アレイにさらなる要素を追加する必要がある場合は、次のようにサイズを変更：

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