При автоматизации работы Access, когда используются другие приложения из пакета MS Office, необходимо знать, установлены ли данные приложения на компьютере. Сейчас существуют много аналогов пакета MS Office, в том числе и бесплатных. Они уступают по функционалу, но имеют меньшие размеры, быстрее работают на слабых компьютерах и совместимы на уровне выходных файлов. Так, что у пользователя на компьютере может и не быть приложений MS Office. Как можно определить, установлен ли на компьютере Excel?
Один из вариантов - попытаться использовать CreateObject() и перехватить ошибку 429, например:
Function IsInstalled() As Boolean
On Error GoTo Error_Handler
Dim oApp As Object
Set oApp = CreateObject("Word.Application")
' Очистить, закрыть, ...
IsInstalled = True
Error_Handler_Exit:
On Error Resume Next
If Not oApp Is Nothing Then Set oApp = Nothing
Exit Function
Error_Handler:
If Err.Number <> 429 Then 'Компонент ActiveX не может создать объект, поэтому не установлен
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: IsInstalled" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
End If
Resume Error_Handler_Exit
End Function
Можно просто заменить Excel любой другой программой: Word, InfoPath,…
Но можно сделать и по-другому. Можно проверить путь установки нужной программы.
' примеры использования
'IsAppInstalled("msaccess.exe")
'IsAppInstalled("excel.exe")
'IsAppInstalled("infopath.exe")
'IsAppInstalled("outlook.exe")
'IsAppInstalled("powerpnt.exe")
'IsAppInstalled("winword.exe")
Function IsAppInstalled(sApp As String) As Boolean
On Error GoTo Error_Handler
If Len(CreateObject("WScript.Shell").RegRead("HKEY_LOCAL_MACHINE\” _
& “SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\" _
& sApp & "\")) > 0 Then IsAppInstalled = True
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number <> -2147024894 Then ‘Неверный корень в реестра, не установлен!
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: IsAppInstalled" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
Debug.Print Err.Number, Err.Description
End If
Resume Error_Handler_Exit
End Function
Таким образом, с помощью одной строчки кода вы можете легко определить, установлена ли программа.
Используемые материалы
Determine if an Application is Installed
Просмотров: 903
 Ваш коментарий будет первым |
 |
| Добавить коментарий |