#573 参照可能なライブラリの一覧を取得するには? VBA

「#565 VBAで参照設定されているライブラリの一覧を取得するには?」では、VBEの[ツール]-[参照設定]メニューで表示される画面でチェックマークが付いているライブラリ、つまりそのVBAのプロジェクトが参照しているライブラリを取得する方法を説明しました。ここでは、その画面で参照可能なライブラリとして表示されるすべてのライブラリを取得する方法を説明します。

基本的には、Windowsを管理するためのインターフェイスであるWMI(Windows Management Instrumentation)を使ってVBAからWindowsのレジストリにアクセスして、「HKEY_CLASSES_ROOT\TypeLib」のサブキーに登録されているデータを取得します。

次のコードでは、取得したライブラリ名をイミディエイトウィンドウに出力しています。
ただし、おそらくすべてのライブラリはイミディエイトウィンドウに表示し切れないので、テキストファイルに出力したりテーブルに出力したりといったアレンジが必要になるかと思います。また、バージョン違いの同名のライブラリ名が取得されることもあるので、クエリを使うなどしてデータを整理することも必要になると思います。

Dim objLocator As Object
Dim objService As Object
Dim objReg As Object
Dim strSearchKey As String
Dim avarKeys As Variant
Dim avarSubKeys As Variant
Dim varResult As Variant
Dim iKeyLoop As Integer
Dim iSubKeyLoop As Integer
Const HKEY_CLASSES_ROOT = &H80000000
Const REG_KEY As String = "TypeLib"

'ロケータを生成する
Set objLocator = CreateObject("WbemScripting.SWbemLocator")
'WMIサービスを生成する
Set objService = objLocator.ConnectServer(vbNullString, "root\default")
'レジストリのデータを取得する
Set objReg = objService.Get("StdRegProv")

'HKEY_CLASSES_ROOT\TypeLibのレジストリキーを配列に取得する
strSearchKey = REG_KEY
objReg.EnumKey HKEY_CLASSES_ROOT, strSearchKey, avarKeys

'キーを検索するループ
For iKeyLoop = LBound(avarKeys) To UBound(avarKeys)
  'カレントキーのサブキーを配列に取得する
  strSearchKey = REG_KEY & "\" & avarKeys(iKeyLoop)
  objReg.EnumKey HKEY_CLASSES_ROOT, strSearchKey, avarSubKeys
  If IsArray(avarSubKeys) Then
    'サブキーがあればサブキーをループで検索する
    For iSubKeyLoop = LBound(avarSubKeys) To UBound(avarSubKeys)
      strSearchKey = REG_KEY & "\" & avarKeys(iKeyLoop) & "\" & avarSubKeys(iSubKeyLoop)
      'サブキーの既定のデータを取得する
      objReg.GetStringValue HKEY_CLASSES_ROOT, strSearchKey, "", varResult
      If Not IsNull(varResult) Then
        '取得したデータを出力する
        Debug.Print varResult
      End If
    Next iSubKeyLoop
  End If
Next iKeyLoop

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


実行例:
実行後のイミディエイトウィンドウ
| Index | Prev | Next |

この情報は参考になりましたか?、問題は解決しましたか?、もしまだなら......
T'sWareのワンポイトテクニカルアドバイスをご利用ください。3000円/件〜でご支援します。
スタンドアロンからSQL Server対応まで、オーダーメイドのシステムを短納期・安価でお届けします
 

Copyright © T'sWare All rights reserved