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 RegQueryValueEx Lib "advapi32.dll" Alias _ "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _ ByVal lpReserved As Long, lpType As Long, _ ByVal lpData As String, lpcbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Const REG_SZ As Long = 1 Const KEY_ALL_ACCESS = &H3F Const HKEY_LOCAL_MACHINE = &H80000002
Public Function OfficePath(OfficeID As String) As String '用途：获取OFFICE安装路径 '用法: OfficePath "Access.Aplication" Dim hKey As Long Dim RetVal As Long Dim sProgId As String Dim sCLSID As String Dim sPath As String
sProgId = OfficeID
RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Classes\" & _ sProgId & "\CLSID", 0&, KEY_ALL_ACCESS, hKey) If RetVal = 0 Then Dim n As Long RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n) sCLSID = Space(n) RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, sCLSID, n) sCLSID = Left(sCLSID, n - 1) 'drop null-terminator RegCloseKey hKey End If RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _ "Software\Classes\CLSID\" & sCLSID & "\LocalServer32", 0&, _ KEY_ALL_ACCESS, hKey) If RetVal = 0 Then RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n) sPath = Space(n)
RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, sPath, n) sPath = Left(sPath, n - 1) OfficePath = sPath#p#分页标题#e# ' MsgBox OfficePath RegCloseKey hKey End If End Function
