excel - VBA - 检测是否安装了应用程序以使用它

Question

我制作了一个Excel文件，其中存储了大量定制工业零件的信息。
它允许用户通过 Outlook 发送预先格式化的邮件来询问新价格。

不幸的是，一些用户没有 Outlook 的“轻型”桌面并且他们收到错误:

Can't find Project or Library

遗憾的是，无法安装 Outlook，后期出价已完成。

<小时/>

我正在考虑预处理器指令，但我不知道如何在我的案例中使用它们......

我知道我们可以用于 Windows 和 VBA 版本的常量:see here

我会做这样的事情:

#If Outlook then
    MsgBox "Outlook is installed"
#Else
    MsgBox "Outlook is NOT installed"
#End if

但这只会检测代码是否从 Outlook 运行，这不是我需要的...:/

<小时/>

所以我想我可以用 On Error 来做一些事情，但它看起来不太整洁，有什么建议吗？

Answer 1

我尝试寻找其他方法来检测应用程序，而不依赖于 CreateObject 的错误

这使用了 WMI 对象，看起来运行良好，但它不区分演示版本
它列出了注册表路径 Microsoft\Windows\CurrentVersion\App Paths(32 和 64 位)

中已安装的应用程序<小时/>

Public Function AppDetected() As Boolean
    Const HKEY_LOCAL_MACHINE = &H80000002   'HKEY_CURRENT_USER = &H80000001
    Const APP_PATH = "\Microsoft\Windows\CurrentVersion\App Paths\"
    Const APP_PATH_32 = "SOFTWARE" & APP_PATH
    Const APP_PATH_64 = "SOFTWARE\Wow6432Node" & APP_PATH
    Const REG_ITM = "!\\.\root\default:StdRegProv"
    Const REG = "winmgmts:{impersonationLevel=impersonate}" & REG_ITM
    Const ID = "Outlook"   '"OUTLOOK.EXE"

    Dim wmi As Object, subKeys As Variant, found As Variant

    If wmi Is Nothing Then Set wmi = GetObject(REG)

    If wmi.EnumKey(HKEY_LOCAL_MACHINE, APP_PATH_32, subKeys) = 0 Then
        If Not IsNull(subKeys) Then found = UBound(Split(Join(subKeys), ID)) > 0
    End If
    If Not found Then
        If wmi.EnumKey(HKEY_LOCAL_MACHINE, APP_PATH_64, subKeys) = 0 Then
            If Not IsNull(subKeys) Then found = UBound(Split(Join(subKeys), ID)) > 0
        End If
    End If
    AppDetected = found
End Function

注意:我只在没有 Outlook 的机器上测试过

有关 WMI Tasks: Registry 的更多详细信息来自微软

<小时/>

使用 MIME 的 WMI 的另一个版本，以 VBScript 显示已安装的 MS 应用程序:

Set wmi = GetObject("winmgmts:\\.\root\CIMV2")
Set itms = wmi.ExecQuery("SELECT * FROM Win32_MIMEInfoAction", "WQL", &h10 + &h20)

For Each itm In itms
    WScript.Echo itm.Name
Next

<小时/>

检测 MS Mail，类似于 CreateObject:Application.ActivateMicrosoftApp xlMicrosoftMail

<小时/>

确定 Outlook 用户帐户:

'If Outlook exists, set reference to Microsoft Outlook *
Public Function ShowOutlookAccount() As Long
    Dim appOutlook As Outlook.Application, i As Long

    Set appOutlook = CreateObject("Outlook.Application")
    For i = 1 To appOutlook.Session.Accounts.Count
        Debug.Print appOutlook.Session.Accounts.Item(i) & " : Account number " & i
    Next
End Function

<小时/>

更多 Outlook utils来自罗恩·德布鲁因