Option Explicit
Private Declare Function RegOpenKey Lib _ "advapi32" Alias "RegOpenKeyA" (ByVal hKey _ As Long, ByVal lpSubKey As String, _ phkResult As Long) As Long 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 Private Declare Function RegCloseKey& Lib _ "advapi32" (ByVal hKey&) Private Const REG_SZ = 1 Private Const REG_EXPAND_SZ = 2 Private Const ERROR_SUCCESS = 0 Public Const HKEY_CLASSES_ROOT = &H80000000 Public Function GetRegString(hKey As Long, _ strSubKey As String, strValueName As _ String) As String Dim strSetting As String Dim lngDataLen As Long Dim 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 On form1 put a CommandButton and four labels with the following code: Option Explicit 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 Command1_Click() Label1.Caption = "Access " & _ IsAppPresent("Access.Database\CurVer", "") Label2.Caption = "Excel " & _ IsAppPresent("Excel.Sheet\CurVer", "") Label3.Caption = "PowerPoint " & _ IsAppPresent("PowerPoint.Slide\CurVer", "") Label4.Caption = "Word " & _ IsAppPresent("Word.Document\CurVer", "") End Sub |