在VBA CreateObject函数如何找到所需要的依赖文件中,为了找到了外部对象所依赖的文件,使用了WScript.Shell对象去读取注册表的信息,这里再介绍直接使用API来读取的方法,还是和操作文件类似,打开-读取-关闭三步:
'打开一个现有的项。在win32下推荐使用这个函数
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
'关闭系统注册表中的一个项(或键)
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
'获取一个项的设置值
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Const HKEY_CLASSES_ROOT As Long = &H80000000
Const HKEY_CURRENT_USER As Long = &H80000001
Const HKEY_LOCAL_MACHINE As Long = &H80000002
Const HKEY_USERS As Long = &H80000003
Const HKEY_PERFORMANCE_DATA As Long = &H80000004
Const HKEY_CURRENT_CONFIG As Long = &H80000005
Const HKEY_DYN_DATA As Long = &H80000006
Const KEY_READ As Long = &H20019
Const KEY_WRITE As Long = &H20006
Function GetObjectDllPath(ObjectName As String) As String
Dim ret As Long
Dim hKey As Long
'打开注册表的某一项
ret = RegOpenKeyEx(HKEY_CLASSES_ROOT, ObjectName & "\CLSID", 0, KEY_READ, hKey)
If ret <> 0 Then
GetObjectDllPath = "RegOpenKeyEx errno=" & ret
Exit Function
End If
GetObjectDllPath = ReadData(hKey, "")
'关闭注册表的某一项
RegCloseKey hKey
ret = RegOpenKeyEx(HKEY_CLASSES_ROOT, "CLSID\" + GetObjectDllPath + "\InprocServer32", 0, KEY_READ, hKey)
If ret <> 0 Then
GetObjectDllPath = "RegOpenKeyEx errno=" & ret
Exit Function
End If
GetObjectDllPath = ReadData(hKey, "")
RegCloseKey hKey
End Function
Function ReadData(hKey As Long, valueName As String) As String
Dim lpType As Long
Dim lpcbData As Long
lpcbData = 512
Dim lpData() As Byte
ReDim lpData(lpcbData - 1) As Byte
Dim ret As Long
'读取注册表某一项的值
ret = RegQueryValueEx(hKey, valueName, 0, lpType, VarPtr(lpData(0)), lpcbData)
If ret <> 0 Then
ReadData = "RegQueryValueEx errno=" & ret
Exit Function
End If
'最后有个0
ReDim Preserve lpData(lpcbData - 1 - 1) As Byte
ReadData = VBA.StrConv(lpData, vbUnicode)
End Function