CodeItBetter Programming Another VB Programming Blog

'MS Office - How to check which Office Components are installed

Public Const HKEY_CLASSES_ROOT = &H80000000
Declare Function RegOpenKey Lib "advapi32" Alias "RegOpenKeyA" (ByVal hKey As Long, _
    ByVal lpSubKey As String, phkResult As Long) As Long
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
Declare Function RegCloseKey& Lib "advapi32" (ByVal hKey&)
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const ERROR_SUCCESS = 0
 
Public Function GetRegString(hKey As Long, strSubKey As String, strValueName As String) As String
    Dim strSetting As String
    Dim lngDataLen As Long, lngRes As Long
    If RegOpenKey(hKey, strSubKey, lngRes) = ERROR_SUCCESS Then
        strSetting = Space(255)
        lngDataLen = Len(strSetting)
        If RegQueryValueEx(lngRes, strValueName, ByVal 0, REG_EXPAND_SZ, ByVal strSetting, _
            lngDataLen) = ERROR_SUCCESS Then
            If lngDataLen > 1 Then
                GetRegString = Left(strSetting, lngDataLen - 1)
            End If
        End If
 
        If RegCloseKey(lngRes) <> ERROR_SUCCESS Then
            MsgBox "RegCloseKey Failed: " & strSubKey, vbCritical
        End If
    End If
End Function
 
Function FileExists(sFileName$) As Boolean
    On Error Resume Next
    FileExists = IIf(Dir(Trim(sFileName)) <> "", True, False)
End Function
 
Public Function IsAppPresent(strSubKey$, strValueName$) As Boolean
    IsAppPresent = CBool(Len(GetRegString(HKEY_CLASSES_ROOT, strSubKey, strValueName)))
End Function
 
Private Sub Main()
    MsgBox "Access " & IsAppPresent("Access.Database\CurVer", "")
    MsgBox "Excel " & IsAppPresent("Excel.Sheet\CurVer", "")
    MsgBox "PowerPoint " & IsAppPresent("PowerPoint.Slide\CurVer", "")
    MsgBox "Word " & IsAppPresent("Word.Document\CurVer", "")
End Sub