Access 获取office的安装路径【函数】

很多人在安装的时候，不会留意安装路径，所以在需找安装目录的时候经常找不到。
office默认的安装路径是：C:\Program Files\Microsoft Office 但是我们一般不会安装到C盘，时间久了我们就会忘记路径了。
下面发一下可以获取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#p#分页标题#e#
'  MsgBox OfficePath
   RegCloseKey hKey
End If
End Function

发布人:andymark-Access中国

分享到：

点击次数：更新时间：2013-09-07 16:11:19 【打印此页】【关闭】

上一条：Access中Application与Docmd对象Quit方法的异同下一条：Access中：几个代表空含义的区别(0、＂＂(空字串)、Null、Empty