Question

我有一个可自动运行Outlook的模块，但如果Outlook不可用，则应跳过它。

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

根据我的测试和此question中的建议，我可以成功捕获Outlook是否尚未配置但是存在失败的边缘情况。这时会出现一个要求选择配置文件的对话框。在这种情况下，检查返回true，但由于仍需要其他配置（例如选择配置文件），Outlook实际上不能用于自动化。是否有可能陷入这种边缘情况？

要重现“选择个人资料”问题，请转到控制面板 - ＆gt;邮件。在对话框中，有一个选项“启动Microsoft Outlook时，使用此配置文件” - 选择“提示使用的配置文件”。然后，当您启动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＆＃39;建议，我找到了一个似乎有用的解决方案。

似乎我甚至不需要打扰注册表检查。我可以简单地这样做：

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

无论Outlook没有配置文件还是需要手动配置文件选择，都将返回0。

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

确定Outlook是否可用于自动化

1 个答案: