Проверка наличия компонентов Microsoft Office.
Автор Виталий   
24.01.2003 г.
Этот код проверит, какие компоненты Microsoft Office установлены на компьютере клиента. Этот код проверит, какие компоненты Microsoft Office установлены на компьютере клиента. Добавте модуль в проект ( в меню Project -> Add Module) и вставте в модуль следующий текст:
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
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

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 Form_Load()
MsgBox "Access " & _
IsAppPresent("Access.DatabaseCurVer", "")
MsgBox "Excel " & _
IsAppPresent("Excel.SheetCurVer", "")
MsgBox "PowerPoint " & _
IsAppPresent("PowerPoint.SlideCurVer", "")
MsgBox "Word " & _
IsAppPresent("Word.DocumentCurVer", "")
End Sub