获取OFFICE的安装路径

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
    '  MsgBox OfficePath
      RegCloseKey hKey
   End If
End Function