Private 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
Private 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
Private Const REG_SZ As Long = 1
Private Const KEY_ALL_ACCESS = &H3F
Private Const HKEY_LOCAL_MACHINE = &H80000002
'*****************************************************
'These functions return the path to the specified office
'application or a 0-length string if the application does not
'exist on the machine. This is one good way to check whether a
'specific office application is present before trying to run
'automation code for that application
'*****************************************************
Public Function GetWordPath() As String
GetWordPath = GetOfficeAppPath("Word.Application")
'display path
MsgBox GetWordPath
End Function
Public Function GetExcelPath() As String
GetExcelPath = GetOfficeAppPath("Excel.Application")
'display path
MsgBox GetExcelPath
End Function
Public Function GetAccessPath() As String
GetAccessPath = GetOfficeAppPath("Access.Application")
'display path
MsgBox GetAccessPath
End Function
Public Function GetOutlookPath() As String
GetOutlookPath = GetOfficeAppPath("Outlook.Application")
'display path
MsgBox GetOutlookPath
End Function
Public Function GetPowerPointPath() As String
GetPowerPointPath = GetOfficeAppPath("PowerPoint.Application")
'display path
MsgBox GetPowerPointPath
End Function
Public Function GetFrontPagePath() As String
GetFrontPagePath = GetOfficeAppPath("FrontPage.Application")
'display path
MsgBox GetFrontPagePath
End Function
Private Function GetOfficeAppPath(ByVal ProgID As String) As String
Dim lKey As Long
Dim lRet As Long
Dim sClassID As String
Dim sAns As String
Dim lngBuffer As Long
Dim lPos As Long
'GetClassID
lRet = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
"Software\Classes\" & ProgID & "\CLSID", 0&, _
KEY_ALL_ACCESS, lKey)
If lRet = 0 Then
lRet = RegQueryValueEx(lKey, "", 0&, REG_SZ, "", lngBuffer)
sClassID = Space(lngBuffer)
lRet = RegQueryValueEx(lKey, "", 0&, REG_SZ, sClassID, _
lngBuffer)
'drop null-terminator
sClassID = Left(sClassID, lngBuffer - 1)
RegCloseKey lKey
End If
'Get AppPath
lRet = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
"Software\Classes\CLSID\" & sClassID & _
"\LocalServer32", 0&, KEY_ALL_ACCESS, lKey)
If lRet = 0 Then
lRet = RegQueryValueEx(lKey, "", 0&, REG_SZ, "", lngBuffer)
sAns = Space(lngBuffer)
lRet = RegQueryValueEx(lKey, "", 0&, REG_SZ, sAns, _
lngBuffer)
sAns = Left(sAns, lngBuffer - 1)
RegCloseKey lKey
End If
'Sometimes the registry will return a switch
'beginning with "/" e.g., "/automation"
lPos = InStr(sAns, "/")
If lPos > 0 Then
sAns = Trim(Left(sAns, lPos - 1))
End If
GetOfficeAppPath = sAns
End Function