Return the Full Path for a Given MS Office Application

Category:

Registry

Type:

Snippets

Difficulty:

Intermediate

Author:

Intelligent Solutions Inc.

Version Compatibility:

More information:

See comments within code for more information

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Option Explicit 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

Code:

'*****************************************************
'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")
End Function

Public Function GetExcelPath() As String
    GetExcelPath = GetOfficeAppPath("Excel.Application")
End Function

Public Function GetAccessPath() As String
    GetAccessPath = GetOfficeAppPath("Access.Application")
End Function

Public Function GetOutlookPath() As String
    GetOutlookPath = GetOfficeAppPath("Outlook.Application")
End Function

Public Function GetPowerPointPath() As String
    GetPowerPointPath = _
       GetOfficeAppPath("PowerPoint.Application")
End Function

Public Function GetFrontPagePath() As String
    GetFrontPagePath = GetOfficeAppPath("FrontPage.Application")
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