【VBA】WMIを利用したレジストリ情報一覧の取得サンプル１

ＶＢＡの参照設定一覧が取得したいと思い、いろいろ調べていたところ、こちらのサイトに、WMIを利用した方法が乗っていた。

自分はWMIをあまり理解していないのでサンプルコードを参考に自分なりにアレンジしてみた。

まだまだ勉強不足だ。

Sub test()
   
    ‘http://msdn.microsoft.com/en-us/library/aa392722(v=vs.85).aspx
    ‘http://msdn.microsoft.com/en-us/library/aa390387(v=vs.85).aspx
    ‘http://msdn.microsoft.com/en-us/library/aa390788(v=vs.85).aspx
   
    ‘microsoft wmi scripting 1.2 参照設定させる。
    Dim oDiskSet As SWbemObjectSet
    Dim oReg As SWbemObjectEx
    Dim oLocator As SWbemLocator
    Dim oService As SWbemServices
   
   
    Dim strSearchKey As String
   
    ‘配列
    Dim Key1 As Variant
    Dim Key2 As Variant
    Dim Key3 As Variant
    Dim Key4 As Variant
    Dim Key5 As Variant
    Dim Key6 As Variant
   
    ‘ループ用
    Dim i, j, k, l, m, n As Long
   
    ‘検索先
    Const HKEY_CLASSES_ROOT = &H80000000
    Const REG_KEY As String = "TypeLib"
   
    Set oLocator = New WbemScripting.SWbemLocator
    Set oService = oLocator.ConnectServer
    Set oReg = oService.Get("StdRegProv")
   
   
    ‘HKEY_CLASSES_ROOT\TypeLibのレジストリキーをKey配列に取得する
    strSearchKey = REG_KEY
    Call GetKeys(oReg, strSearchKey, Key1)
   
    ‘key配列をループさせレジストリ情報取得
    For i = LBound(Key1) To UBound(Key1)
        GetStringValueFromRoot oReg, Key1(i)
        If GetKeys(oReg, strSearchKey & "\" & Key1(i), Key2) = True Then
            For j = LBound(Key2) To UBound(Key2)
‘                GetStringValueFromRoot oReg, strSearchKey & "\" & Key1(i) & "\" & Key2(j)
                If GetKeys(oReg, strSearchKey & "\" & Key1(i) & "\" & Key2(j), Key3) = True Then
                    For k = LBound(Key3) To UBound(Key3)
‘                        GetStringValueFromRoot oReg, strSearchKey & "\" & Key1(i) & "\" & Key2(j) & "\" & Key3(k)
                        If GetKeys(oReg, strSearchKey & "\" & Key1(i) & "\" & Key2(j) & "\" & Key3(k), Key4) = True Then
                            For l = LBound(Key4) To UBound(Key4)
                                GetStringValueFromRoot oReg, strSearchKey & "\" & Key1(i) & "\" & Key2(j) & "\" & Key3(k) & "\" & Key4(l)
                                If GetKeys(oReg, strSearchKey & "\" & Key1(i) & "\" & Key2(j) & "\" & Key3(k) & "\" & Key4(l), Key5) = True Then
                                    For m = LBound(Key5) To UBound(Key5)
                                        GetStringValueFromRoot oReg, strSearchKey & "\" & Key1(i) & "\" & Key2(j) & "\" & Key3(k) & "\" & Key4(l) & "\" & Key5(m)
                                            If GetKeys(oReg, strSearchKey & "\" & Key1(i) & "\" & Key2(j) & "\" & Key3(k) & "\" & Key4(l) & "\" & Key5, Key6) = True Then
                                                For n = LBound(Key6) To UBound(Key6)
                                                    GetStringValueFromRoot oReg, strSearchKey & "\" & Key1(i) & "\" & Key2(j) & "\" & Key3(k) & "\" & Key4(l) & "\" & Key5(m) & "\" & Key6(n)
                                                Next n
                                            End If
                                    Next m
                                End If
                            Next l
                        End If
                    Next k
                End If
            Next j
        End If
    Next i
       
       

    Set objReg = Nothing
    Set objService = Nothing
    Set objLocator = Nothing

End Sub

Function GetKeys(ByRef oReg As SWbemObjectEx, ByVal strSearchKey As String, ByRef SubKeys As Variant) As Boolean
    Const HKEY_CLASSES_ROOT = &H80000000 ‘ROOT固定
    Const REG_KEY As String = "TypeLib"  ‘TypeLib固定
    GetKeys = False
    oReg.EnumKey HKEY_CLASSES_ROOT, strSearchKey, SubKeys
    If IsArray(SubKeys) Then
        GetKeys = True
    End If
End Function

Function GetStringValueFromRoot(ByRef oReg As SWbemObjectEx, ByVal strSearchKey As String) As Variant
    ‘http://msdn.microsoft.com/en-us/library/aa390788(v=vs.85).aspx
    Const HKEY_CLASSES_ROOT = &H80000000 ‘ROOT固定
    Const REG_KEY As String = "TypeLib"  ‘TypeLib固定
   
    Dim varResult As Variant
    varResult = Null
    ‘サブキーの既定のデータを取得する
    oReg.GetStringValue HKEY_CLASSES_ROOT, strSearchKey, "", varResult
    If Not IsNull(varResult) Then
        ‘取得したデータを出力する
        Debug.Print strSearchKey & " " & varResult
    End If
    GetStringValueFromRoot = varResult

End Function