确定现有 Outlook 实例是否打开

Question

在阅读了如何使用自动化发送消息后，我不清楚如果我已经打开了 Outlook 的新实例，是否可以避免打开一个新实例。如果是这样，我不确定如何搜索确定现有 Outlook 实例是否打开的示例。

-----包括建议--------

我有以下sn-p，但我发现我无法正确创建实例。我基本上在关注this example。我要么收到this screenshot，要么收到“未定义用户定义类型”的错误。有什么建议吗？

Sub Example()
    'Dim w As Outlook.Application

    Const ERR_APP_NOTRUNNING As Long = 429
    On Error Resume Next


' Handle Microsoft outlook
    Set w = GetObject(, "Outlook.Application")
    If Err = ERR_APP_NOTRUNNING Then
      'Set w = New Outlook.Application
      Set w = CreateObject("Outlook.Application")
    End If
End Sub

Answer 1

我知道这个问题已经得到解答，但我想补充一点，像 Outlook 之类的应用程序（我相信 PowerPoint 也是如此）是单实例应用程序——无需确定 Outlook 是否已经打开，因为您只能运行一份 Outlook。

http://msdn.microsoft.com/en-us/library/aa164542(v=office.10).aspx

如果需要实例化 Outlook，只需使用 CreateObject 创建实例即可；如果 Outlook 已经在运行，您的对象引用将指向现有实例。如果没有，您将创建该类。绑定（迟或早）无关紧要。

例如，假设 Outlook 没有运行。我们可以使用这段代码来创建实例：

Sub testOutlook()

Dim olApp As Object ' Outlook.Application

Set olApp = CreateObject("Outlook.Application")
  MsgBox (olApp2 Is Nothing)

End Sub

这将打印“False”，因为我们创建了实例。

假设 Outlook 正在运行。我们可以使用这段代码来验证使用 GetObject 和 CreateObject 是否会引用现有实例：

Sub testOutlook()

Dim olApp As Object ' Outlook.Application
Dim olApp2 As Object ' Outlook.Application

Set olApp = GetObject(, "Outlook.Application")
  MsgBox (olApp Is Nothing)

Set olApp2 = CreateObject("Outlook.Application")
  MsgBox (olApp2 Is Nothing)
  MsgBox "Same object? " & (olApp Is olApp2)

End Sub

这将打印“False”（现有实例）、“False”（我们所谓的“新实例”），但最后一个消息框是“True”，因为新实例实际上与现有实例是同一个对象。

如果我们不知道 Outlook 是否正在运行，我们该怎么办？如上所示，CreateObject 要么创建一个新实例（如果不存在，如第一个示例），要么挂钩现有实例，如果 Outlook 已打开（如第二个示例）。

Answer 2

我在你的问题中看到你注释掉了

'Dim w As Outlook.Application

大概是因为这会给您“未定义用户定义的类型”错误。

这可能是因为您没有在 Excel-VBA 项目中设置对 Outlook 库的引用。操作如下：工具 > 参考 > 选中“Microsoft Outlook xx.x 对象库”。然后就可以这样写了

Dim w As Outlook.Application
Set w = New Outlook.Application
' or, 
'Set w = CreateObject("Outlook.Application")

顺便说一句，这会导致编译时（或“早期”）绑定。并为您提供Outlook 对象智能感知。

或者，您可以省略设置引用并将w 声明为通用对象并让它在运行时绑定

Dim w As Object
Set w = CreateObject("Outlook.Application")

但runtime (or "late") binding 效率较低。

做任何感觉最好的事情——我会继续冒险，你可能不会注意到效率的差异。我最近改用了早期绑定的东西，真的只是因为智能感知。

编辑所以您创建了一个新的 Outlook 应用程序，但您看不到它。如果您查看 Windows 任务管理器，您会看到该进程在那里，正在运行——但它只是没有显示在屏幕上。不幸的是，微软的一些杰出工程师认为 Outlook 不应该像 Word 或 Excel 那样具有 Visible 属性，因此我们不得不使用一种尴尬的解决方法。打开特殊文件夹之一，例如收件箱是这样的：

Dim w As Outlook.Application
Dim wInbox As Outlook.MAPIFolder

Set w = New Outlook.Application
Set wInbox = w.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

wInbox.Display 'This makes Outlook visible

Answer 3

    Set w = GetObject(, "Outlook.Application")

这应该运行实例，如果没有运行捕获错误并执行 CreateObject

Answer 4

如果您愿意，请使用它。
这不是一个完美的解决方案，但您可以在 Outlook App 未打开时打开它。

Function OpenOutlookApp(isSend As Boolean) As Boolean

    ' If it has opened, return true.
    ' my office version is 2016.

    Dim oApp As Object

    On Error GoTo ErrorHandle

    On Error Resume Next

    Set oApp = GetObject(, "Outlook.Application")

    On Error GoTo 0

    If oApp Is Nothing Then

        Set oApp = CreateObject("Outlook.Application")

        oApp.GetNamespace("MAPI").GetDefaultFolder(6).Display

    End If

    If isSend Then Call SendAndReceiveOutlookMail(False)

    OpenOutlookApp = True

    GoTo NonErrorHandle

    ErrorHandle:
        
    NonErrorHandle:

    On Error GoTo 0

End Function

Sub SendAndReceiveOutlookMail(isQuit As Boolean)

    Dim oApp As New Outlook.Application

    On Error Resume Next

    Call oApp.Session.LogOn("Outlook", "")

    Call oApp.Session.SendAndReceive(True)

    If isQuit Then oApp.Quit

    Set oApp = Nothing

    On Error GoTo 0

End Sub