VBA – 检测应用程序是否安装使用它

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

不幸的是，一些用户没有Outlook的“轻”桌面 ，他们得到一个错误：

找不到项目或库

不幸的是，安装Outlook不是一个选项，晚了已经完成了。

---

我正在考虑预处理指令，但我不知道如何使用它们在我的情况下…

我知道我们可以用于Windows和VBA版本的常量： 请参阅这里

我会做这样的事情：

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

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

---

所以我想我可以用On Error做一些事情，但看起来并不整齐，有什么build议吗？

Answer 1

我试图find其他方式来检测应用程序，而不依靠从CreateObject的错误

这使用WMI对象，它似乎工作正常，但它不区分演示版本
它列出已安装的应用程序在registrypathMicrosoft\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的机器上testing过

有关WMI任务的详细信息：来自MS的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应用程序

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

这是我的解决scheme：

 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 

我们的想法是，我们做一个布尔函数，定义是否安装了对象，取一个可选的string，从而可以检查各种对象。 作为一个string值，更容易检查。

使用预处理器指令做这件事似乎是不可能的，因为你需要设置一个常量等于一个函数，检查是否安装了Outlook，常量不喜欢这种方式。