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

VBA（Visual Basic for Applications）からWMI（Windows Management Instrumentation）の StdRegProv クラスを利用して、レジストリ情報を取得するサンプルコードです。

この記事では、レジストリの HKEY_CLASSES_ROOT\TypeLib キー配下を再帰的に走査し、登録されている情報を取得する手順とサンプルコードを紹介します。

前提条件

• Windows環境での実行を想定しています。
• WMIスクリプトライブラリを利用するため、必要に応じて参照設定を確認してください。

WMIレジストリ取得サンプルコード

Sub test()    
    ' 参考: https://learn.microsoft.com/en-us/windows/win32/wmi/stdregprov
    
    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配列をループさせレジストリ情報取得
    If IsArray(Key1) Then
        For i = LBound(Key1) To UBound(Key1)
            GetStringValueFromRoot oReg, strSearchKey & "\" & Key1(i)
            If GetKeys(oReg, strSearchKey & "\" & Key1(i), Key2) = True Then
                For j = LBound(Key2) To UBound(Key2)
                    If GetKeys(oReg, strSearchKey & "\" & Key1(i) & "\" & Key2(j), Key3) = True Then
                        For k = LBound(Key3) To UBound(Key3)
                            If GetKeys(oReg, strSearchKey & "\" & Key1(i) & "\" & Key2(j) & "\" & Key3(k), Key4) = True Then
                                For l = LBound(Key4) To UBound(Key4)
                                    If GetKeys(oReg, strSearchKey & "\" & Key1(i) & "\" & Key2(j) & "\" & Key3(k) & "\" & Key4(l), Key5) = True Then
                                        For m = LBound(Key5) To UBound(Key5)
                                            If GetKeys(oReg, strSearchKey & "\" & Key1(i) & "\" & Key2(j) & "\" & Key3(k) & "\" & Key4(l) & "\" & Key5(m), 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
    End If
    
    Set oReg = Nothing
    Set oService = Nothing
    Set oLocator = Nothing

End Sub

Function GetKeys(ByRef oReg As SWbemObjectEx, ByVal strSearchKey As String, ByRef SubKeys As Variant) As Boolean
    Const HKEY_CLASSES_ROOT = &H80000000
    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
    Const HKEY_CLASSES_ROOT = &H80000000
    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