确定 Outlook 是否可用于自动化

Question

我有一个模块可以自动执行 Outlook，但如果 Outlook 不可用，应该跳过它。

仅仅检查是否安装了 Outlook 是不够的，因为如果安装了全新的 Office，启动 Outlook 只会启动配置向导。从我的 POV 来看，Outlook 不可用于自动化，因此不应使用该模块，即使它可能已安装。

根据我的测试和此 question 中的建议，我可以成功地判断 Outlook 是否尚未配置，但在极端情况下会失败。这是当有一个对话框要求 select 配置文件时。在这种情况下，检查 returns true 但 Outlook 实际上不能用于自动化目的，因为仍然需要额外的配置（例如 select 配置文件）。是否也可以捕获这种边缘情况？

要重现 "Select Profile" 问题，请转至控制面板 -> 邮件。在对话框中，有一个选项 "When starting Microsoft Outlook, use this profile" - select "Prompt for a profile used"。当您随后启动 Outlook 时，系统会要求您选择一个配置文件。当下面的代码失败时就是这种情况。

到目前为止，这是我几乎可以工作的代码...

Public Function DetectOutlookProfile() As Boolean
    Dim objOutlook As Object
    Dim objReg As Object
    Dim varSplit As Variant
    Dim lngMajor As Long
    Dim strPath As String
    Dim varSubKeys As Variant
    Dim varSubKey As Variant

    Const HKEY_CURRENT_USER As Long = &H80000001

On Error GoTo ErrHandler

    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\.\root\default:StdRegProv")

    'Get an instance of Outlook so that we can determine the version
    'being currently used by the current user. 
    Set objOutlook = CreateObject("Outlook.Application")
    varSplit = Split(objOutlook.Version, ".")
    lngMajor = varSplit(0)
    If lngMajor <= 14 Then
        'Outlook profile isn't version specific for Outlook 97-2010
        strPath = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
    Else
        'Outlook profile is version specific for Outlook 2013+
        strPath = "Software\Microsoft\Office\" & lngMajor & ".0\Outlook\Profiles"
    End If

    objReg.EnumKey HKEY_CURRENT_USER, strPath, varSubKeys
    For Each varSubKey In varSubKeys
        DetectOutlookProfile = True
        Exit For
    Next

ExitProc:
    On Error Resume Next
    Exit Function
ErrHandler:
    'Silently fail and return false
    Select Case Err.Number
        Case Else
            DetectOutlookProfile = False
            Debug.Print Err.Number & " (" & Err.Description & ")"
    End Select
    Resume ExitProc
    Resume
End Function

Answer 1

感谢@David Zemens 的建议，我找到了一个似乎可行的解决方案。

看来我连注册表检查都不用操心了。我可以简单地这样做：

Set objOutlook = CreateObject("Outlook.Application") 
DetectOutlookProfile = Len(objOutlook.GetNamespace("MAPI").CurrentProfileName)

无论 Outlook 没有配置文件还是需要手动选择配置文件，这将 return0。

我想需要进行注册表检查以确定 Outlook 是否配置了 any 配置文件，以便可以编写代码以手动提示用户将配置文件传递到其中Login 方法。对于我的情况，我只是不想在任何一种情况下运行模块，因此检查 Len() 当前配置文件名称就足够了。

确定 Outlook 是否可用于自动化

Determine if Outlook is available for automation

outlook

vba

office-automation