Search code examples
vbaoutlookoffice-automation

Determine if Outlook is available for automation


I have a module that will automate Outlook but it should be skipped if Outlook isn't available.

Simply checking whether Outlook is installed is not sufficient because if there is a fresh Office install, launching Outlook will simply launch the configuration wizard. From my POV, Outlook is not available for automation so the module shouldn't be used even though it might be installed.

From my tests and the suggestions in this question, I can successfully trap for whether Outlook isn't configured yet but there is an edge case where this fails. This is when there is a dialog that asks to select a profile. In this situation, the check returns true but Outlook is actually not usable for the purposes of automation due to still needing additional configuration (e.g. selecting a profile). Is it possible to also trap this edge case?

To reproduce the "Select Profile" issue, go to Control Panel -> Mail. On the dialog, there is a option to "When starting Microsoft Outlook, use this profile" - select "Prompt for a profile used". When you then launch Outlook, you are asked to choose a profile. That is the case when the code below will fail.

This is my almost-working code so far...

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

Solution

  • Thanks to @David Zemens' suggestions, I found a solution that seems to work.

    It seems that I don't even need to bother with registry checks. I can simply do this instead:

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

    Which will return 0 whether the Outlook has no profiles or is requiring a manual profile selection.

    I suppose the registry check is needed to determine whether the Outlook has any profiles configured so that one's code could be then written to manually prompt the user for profile to be passed into Login method. For my case, I just don't want to run the module in either case, so the checking Len() of the current profile name suffices.