VBScript: Сбор всех настроек Internet Explorer из реестра

<HKEY_CURRENT_USER>
     <Software>
          <Microsoft>
               <Internet Explorer>
                    <Parameter Name>Parameter1</Parameter Name>
                    <Parameter Value>Value1</Parameter Value>
                    <Parameter Type>DWORD</Parameter Type>
               </Internet Explorer>
          </Microsoft>
     </Software>
</HKEY_CURRENT_USER>

strComputer = "." ' Скорее всего для этой задачи не понадобится

Set objNet = WScript.CreateObject("WScript.NetWork") 'Объект для получения имени пользователя
Set WshShell = WScript.CreateObject("WScript.Shell") '
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") 'Объект для файловой системы (нужен для результирующего файла)
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") ' Подключение к реестру

Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005

Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7

REM ResultPath = "d:\"
REM ResultFileName = objNet.UserName & ".txt"
Const Internet_Settings = "Software\Microsoft\Windows\CurrentVersion\Internet Settings"

Function ReadKey(strKey)
    'Чтение параметров раздела
    intRes = objReg.EnumValues(HKEY_CURRENT_USER, strKey, sNames, Types)
    If intRes <> 0 Then
        ScriptError = True
    End If
    If IsArray(sNames) Then
        i = 0
        For Each Param In sNames
            If Types(i) = REG_SZ Then
                intRes = objReg.GetStringValue(HKEY_CURRENT_USER, strKey, Param, Val)
            Elseif Types(i) = REG_EXPAND_SZ Then
                intRes = objReg.GetExpandedStringValue(HKEY_CURRENT_USER, strKey, Param, Val)
            Elseif Types(i) = REG_BINARY Then
                intRes = objReg.GetBinaryValue(HKEY_CURRENT_USER, strKey, Param, Val)
            Elseif Types(i) = REG_DWORD Then
                intRes = objReg.GetDWORDValue(HKEY_CURRENT_USER, strKey, Param, Val)
                Val = Right("00000000" & LCase(Hex(Val)), 8)
            Elseif Types(i) = REG_MULTI_SZ Then
                intRes = objReg.GetMultiStringValue(HKEY_CURRENT_USER, strKey, Param, Val)
            End If
            If intRes <> 0 Then
                ScriptError = True
            End If
            ' Дополнительные преобразования бинарного и многострочного типов
            If Types(i) = REG_BINARY Then
                For j = 0 To UBound(Val)
                    Val(j) = Right("00" & Hex(Val(j)), 2)
                Next
                Val = Join(Val)
            Elseif Types(i) = REG_MULTI_SZ Then
                Val = vbCrLf & Join(Val, vbCrLf)
            End If
            'Вот сюда нужно добавить функцию записи полученного значения в файл в нужном нам формате
            REM objResult.WriteLine "HKEY_CURRENT_USER\" & strKey & "\" & Param & "|" & Val
            con.execute "INSERT INTO [settings] ([user], [key], [type], [value]) VALUES ('" & replace(username, "'", "''") & "', 'HKEY_CURRENT_USER\" & replace(strKey & "\" & Param, "'", "''") & "', " & Types(i) & ", '" & replace(Val, "'", "''") & "');"
            i = i + 1
        Next
    End If
    'Обход подразделов
    intRes = objReg.EnumKey(HKEY_CURRENT_USER, strKey, sNames)
    If intRes <> 0 Then
        ScriptError = True
    End If
    If IsArray(sNames) Then
        For Each strSubKey In sNames
            ReadKey strKey & "\" & strSubKey
        Next
    End If
End Function

' если скрипт запущен из %windir%\system32\ под win x64 - перезапуск из %windir%\syswow64\
with createobject("WScript.Shell")
    if replace(lcase(wscript.path), lcase(.expandenvironmentstrings("%windir%\")), "") = "system32" then
        cmdln = replace(lcase(wscript.fullname), "system32", "syswow64")
        if createobject("scripting.filesystemobject").fileexists(cmdln) then
            cmdln = cmdln & " """ & wscript.scriptfullname & """"
            for each arg in wscript.arguments
                cmdln = cmdln & " """ & arg & """"
            next
            .run cmdln
            wscript.quit
            end if
    end if
end with
' путь к БД
dbpath = "\\DELL\Transfer\dump.mdb"
' соединение / создание БД
set cat = createobject("adox.catalog")
constr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source='" & dbpath & "';Mode=ReadWrite|Share Deny None;"
if not objFSO.fileexists(dbpath) then
    cat.create constr
else
    cat.activeconnection = constr
end if
set con = cat.activeconnection
' проверка наличия таблицы
hastable = false
for each elt in cat.tables
    if elt.name = "settings" then
        hastable = true
        exit for
    end if
next
' запрос на создание таблицы
if not hastable then
    con.execute "CREATE TABLE [settings] ([user] LONGTEXT, [key] LONGTEXT, [type] SHORT, [value] LONGTEXT);"
end if
username = objNet.UserName

REM on Error resume Next
REM Set objResult = objFSO.CreateTextFile(ResultPath & ResultFileName, True)
REM objResult.WriteLine "Parameter|Value"
ReadKey Internet_Settings

Set objNet = Nothing
Set objFSO = Nothing
msgbox "completed"
con.close
set con = nothing
set cat = nothing
WScript.Quit 0

' если скрипт запущен из %windir%\system32\ под win x64 - перезапуск из %windir%\syswow64\
with createobject("WScript.Shell")
    if replace(lcase(wscript.path), lcase(.expandenvironmentstrings("%windir%\")), "") = "system32" then
        cmdln = replace(lcase(wscript.fullname), "system32", "syswow64")
        if createobject("scripting.filesystemobject").fileexists(cmdln) then
            cmdln = cmdln & " """ & wscript.scriptfullname & """"
            for each arg in wscript.arguments
                cmdln = cmdln & " """ & arg & """"
            next
            .run cmdln
            wscript.quit
            end if
    end if
end with
' путь к БД
dbpath = "\\DELL\Transfer\dump.mdb"
' соединение
set cat = createobject("adox.catalog")
cat.activeconnection = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source='" & dbpath & "';Mode=ReadWrite|Share Deny None;"
set con = cat.activeconnection
' работа со сводной таблицей pivotsettings 
hastable = false
for each elt in cat.tables
    if elt.name = "pivotsettings" then
        hastable = true
        exit for
    end if
next
' если таблица есть - запрос на удаление таблицы
if hastable then
    con.execute "DROP TABLE [pivotsettings];"
end if
' создание таблицы c записями неповторяющихся ключей и типов
con.execute "CREATE TABLE [pivotsettings] ([key] LONGTEXT, [type] SHORT);"
con.execute "INSERT INTO [pivotsettings] ([key], [type]) SELECT DISTINCT [key], [type] FROM [settings];"
set rs = con.execute("SELECT DISTINCT [user] FROM [settings];")
' добавление полей для каждого из пользователей
rs.movefirst
do until rs.eof
    value = rs.fields("user").value
    con.execute "ALTER TABLE [pivotsettings] ADD [" & value & "] LONGTEXT;"
    rs.movenext
loop
' обновление значений ключей для каждого из пользователей
rs.movefirst
do until rs.eof
    value = rs.fields("user").value
    con.execute "UPDATE [pivotsettings], [settings] SET [pivotsettings].[" & value & "] = [settings].[value] WHERE [settings].[user] = '" & replace(value, "'", "''") & "' And [settings].[key] = [pivotsettings].[key] And [settings].[type] = [pivotsettings].[type];"
    rs.movenext
loop
set rs = nothing
con.close
set con = nothing
set cat = nothing
msgbox "completed"

On Error Resume Next

arrComputers = Array("PC1", "PC2", "PC3")

Set objNet = WScript.CreateObject("WScript.NetWork") 'Объект для получения имени пользователя
Set WshShell = WScript.CreateObject("WScript.Shell") '
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") 'Объект для файловой системы (нужен для результирующего файла)

Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005

Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7

Const Internet_Settings = "Software\Microsoft\Windows\CurrentVersion\Internet Settings"

Set objXL = WScript.CreateObject("Excel.Application")
objXL.Visible = True
objXL.Workbooks.Add
objXL.ScreenUpdating = False

col = 2

For Each strComputer In arrComputers
    objXL.Cells(1, col).Value = strComputer
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv") ' Подключение к реестру
    ReadKey Internet_Settings
    col = col + 1
Next
objXL.Cells.Columns.AutoFit
objXL.ActiveSheet.Sort.Apply
objXL.ScreenUpdating = True

Function ReadKey(strKey)
    'Чтение параметров раздела
    intRes = objReg.EnumValues(HKEY_CURRENT_USER, strKey, sNames, Types)
    If intRes <> 0 Then
        ScriptError = True
    End If
    If IsArray(sNames) Then
        i = 0
        For Each Param In sNames
            If Types(i) = REG_SZ Then
                intRes = objReg.GetStringValue(HKEY_CURRENT_USER, strKey, Param, Val)
            ElseIf Types(i) = REG_EXPAND_SZ Then
                intRes = objReg.GetExpandedStringValue(HKEY_CURRENT_USER, strKey, Param, Val)
            ElseIf Types(i) = REG_BINARY Then
                intRes = objReg.GetBinaryValue(HKEY_CURRENT_USER, strKey, Param, Val)
            ElseIf Types(i) = REG_DWORD Then
                intRes = objReg.GetDWORDValue(HKEY_CURRENT_USER, strKey, Param, Val)
                Val = Right("00000000" & LCase(Hex(Val)), 8)
            ElseIf Types(i) = REG_MULTI_SZ Then
                intRes = objReg.GetMultiStringValue(HKEY_CURRENT_USER, strKey, Param, Val)
            End If
            If intRes <> 0 Then
                ScriptError = True
            End If
            ' Дополнительные преобразования бинарного и многострочного типов
            If Types(i) = REG_BINARY Then
                For j = 0 To UBound(Val)
                    Val(j) = Right("00" & Hex(Val(j)), 2)
                Next
                Val = Join(Val)
            ElseIf Types(i) = REG_MULTI_SZ Then
                Val = vbCrLf & Join(Val, vbCrLf)
            End If
            '------------------------------------------------------------
            found = False
            For Row = 1 To objXL.ActiveSheet.UsedRange.Rows.Count
                If objXL.Cells(Row, 1).Value = "HKEY_CURRENT_USER\" & strKey & "\" & Param Then
                    With objXL.Cells(Row, col)
                    .NumberFormat = "@"
                    .Value = Val
                    End With
                    found = True
                End If
            Next
            If Not found Then
                objXL.Cells(Row, 1).Value = "HKEY_CURRENT_USER\" & strKey & "\" & Param
                    With objXL.Cells(Row, col)
                    .NumberFormat = "@"
                    .Value = Val
                    End With
            End If
            '------------------------------------------------------------
            i = i + 1
        Next
    End If
    'Обход подразделов
    intRes = objReg.EnumKey(HKEY_CURRENT_USER, strKey, sNames)
    If intRes <> 0 Then
        ScriptError = True
    End If
    If IsArray(sNames) Then
        For Each strSubKey In sNames
            ReadKey strKey & "\" & strSubKey
        Next
    End If
End Function