Question

我制作了一个 Excel文件，存储了很多自定义工业零件的信息它允许用户通过Outlook发送预先格式化的邮件来要求新的价格。

不幸的是，有些用户在没有Outlook 的情况下拥有“light”桌面，并且他们收到了错误消息：

无法找到项目或资料库

不幸的是，安装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＆amp; 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

的计算机上测试过它

有关MS {/ 3>}的WMI Tasks: Registry的详细信息

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

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

来自Ron de Bruin的更多Outlook utils

Answer 2

你可以这样做：

Sub Whatever()
    Dim obj As Object
    Set obj = CreateObjectType("Outlook.Application")

    If Not obj Is Nothing Then
        '...
    End If

End Sub

Public Function CreateObjectType(objectType As Variant) As Object
    On Error Resume Next
    CreateObjectType = CreateObject(objectType)
End Function

Answer 3

你可以尝试一下......

Dim olApp As Object
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
   MsgBox "Outlook is not installed on your system." & vbNewLine & vbNewLine & _
         "Please Install & Configure The Outlook And Then Try Again...", vbExclamation, "Outlook Not Installed!"
   Exit Sub
End If

Answer 4

这是我的解决方案：

Option Explicit

Sub TestMe()

    Debug.Print blnObjectInstalled

End Sub

Public Function blnObjectInstalled(Optional strObjectType As String = "Outlook.Application") As Boolean

    On Error GoTo blnobjectInstalled_Error

    Dim obj As Object
    Set obj = CreateObject(strObjectType)

    blnObjectInstalled = True

    On Error GoTo 0
    Exit Function

blnobjectInstalled_Error:

    blnObjectInstalled = False

End Function

我们的想法是我们创建一个布尔函数，定义是否安装了对象，采用可选字符串，因此它可以检查各种对象。作为字符串值，更容易检查。

使用预处理程序指令执行此操作似乎是不可能的，因为您需要设置一个等于检查Outlook是否已安装的函数的常量，并且常量不喜欢这样。

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

4 个答案: