[VB6] How Do I Check If MS Office Is Installed?

[HanneSThEGreaT]

Q: What Is Needed To Check If MS Office Is Installed?

A: Well, all that is basically needed is the Regsitry APIs. These APIs allow us to interrogate the Windows Registry; and as well know ( hopefully ), all the application data gets stored in the registry. Stuff like Recent Opened Documents, File Extensions of files and so on. Add these APIs to your Form :

'The RegOpenKey function uses the default security access mask to open a key
Private Declare Function RegOpenKey Lib "advapi32" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

'Retrieves the type and data for the specified value name associated with an open registry key
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, lpReserved As Long, lptype As Long, lpData As Any, lpcbData As Long) As Long

'The RegCloseKey function releases the handle of the specified key
Private Declare Function RegCloseKey& Lib "advapi32" (ByVal hKey&)

Private Const HKEY_CLASSES_ROOT = &H80000000 'The HKEY_CLASSES_ROOT (HKCR) key contains file name extension associations and COM class registration information such as ProgIDs, CLSIDs, and IIDs.
Private Const REG_SZ = 1 'Constant that is needed for Registry functions
Private Const REG_EXPAND_SZ = 2 'A null-terminated string that contains unexpanded references to environment

Private Const WM_QUIT As Long = &H12 'he WM_QUIT message indicates a request to terminate an application and is generated when the application calls the PostQuitMessage function.

Private Const ERROR_SUCCESS = 0 'Win32 error code indicating success

Q: OK, so How Do I Use These APIs?

A: We have to create a Function that not only reads the certain regsitry key for the existance of the Office Applications, but to return some sort of value to us to indicate whether or not that specific registry entry exists or not :

'Function that reads registry value at specified Hive and Key Location
Private Function GetRegString(hKey As Long, strSubKey As String, strValueName As String) As String
    
    Dim strSetting As String 'Store Setting
    Dim lngDataLen As Long 'How Much Info
    Dim lngRes As Long 'Return Result
    
    'Open key
    If RegOpenKey(hKey, strSubKey, lngRes) = ERROR_SUCCESS Then
        strSetting = Space(255)
        
        lngDataLen = Len(strSetting)
        
        'If possible to go deeper, get next value
        If RegQueryValueEx(lngRes, strValueName, ByVal 0, REG_EXPAND_SZ, ByVal strSetting, lngDataLen) = ERROR_SUCCESS Then
            
            'If there is something, get it
            If lngDataLen > 1 Then
                GetRegString = Left(strSetting, lngDataLen - 1)
            End If
            
        End If

        'Close key
        If RegCloseKey(lngRes) <> ERROR_SUCCESS Then
            MsgBox "RegCloseKey Failed: " & strSubKey, vbCritical
        End If
        
    End If
    
End Function

Q: Hmm.... Interesting! But... How do I actually use this Function?

A: We have to create yet another function that gives us more desireble results, for example, the next function simply returns TRUE or FALSE. Now we can use this Function to determine what we want :

'Function that tests GetRegString function to determine if our applications are present
Private Function IsAppPresent(strSubKey$, strValueName$) As Boolean
    
    IsAppPresent = CBool(Len(GetRegString(HKEY_CLASSES_ROOT, strSubKey, strValueName)))

End Function

Q: So how do I Check For The Existance of Access, Excel, PowerPoint and Word?

A: Simple, with the use of the above function :

Private Sub Command1_Click()

'Is Access Present?
    If IsAppPresent("Access.Database\CurVer", "") = False Then
        MsgBox "Please Install MS Office", vbCritical, "Exam Finder Error"
    Else
        MsgBox "Access Is Installed!"
    End If
    
End Sub

Private Sub Command2_Click()

'Is Excel Present?
    If IsAppPresent("Excel.Sheet\CurVer", "") = False Then
        MsgBox "Please Install MS Office", vbCritical, "Exam Finder Error"
    Else
        MsgBox "Excel Is Installed!"
    End If
    
End Sub

Private Sub Command3_Click()

'Is PowerPoint present?
    If IsAppPresent("PowerPoint.Slide\CurVer", "") = False Then
        MsgBox "Please Install MS Office", vbCritical, "Exam Finder Error"
    Else
        MsgBox "PowerPoint Is Installed!"
    End If
    
End Sub

Private Sub Command4_Click()

'Is Word present?
    If IsAppPresent("Word.Document\CurVer", "") = False Then
        MsgBox "Please Install MS Office", vbCritical, "Exam Finder Error"
    Else
        MsgBox "Word Is Installed!"
    End If

End Sub

A full Working example is attached to this post.