OFFICE集成/导入导出/交互
Access 获取office的安装路径【函数】
2013-09-07 16:11:19
很多人在安装的时候，不会留意安装路径，所以在需找安装目录的时候经常找不到。
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