refer to Outllook (new) vba

[drom]

Hi and Thanks in advance!
I have been using this rondebruin code for many years:

'https://www.rondebruin.nl/win/s1/outlook/openclose.htm
Function Fx_bOutLookIsOpen() As Boolean
  On Error Resume Next:         Application.ScreenUpdating = True
 Err.Clear
Dim OutApp As Object:           Set OutApp = GetObject(, "Outlook.Application")
                                If Err<>0 Then Set OutApp = CreateObject("Outlook.application")
    If Not OutApp Is Nothing Then
      Fx_bOutLookIsOpen = True
    Else
        Fx_bOutLookIsOpen = False
    End If
End Function

The Code Workeed very well for many years
Now I am using a new version of Outlook and despite the Outlook is open (and I know is open) the prior code does not work
OutApp gives me nothing

So I found this following code and adapted a bit:
on the inmediate window:
IsProgramOpen("OUTLOOK.EXE")

' http://www.vbaexpress.com/forum/showthread.php?70793-Sleeper-New-Outlook-Broken-my-VBA
Public Function IsProgramOpen(ByVal wProgramName As String) As Boolean
  On Error Resume Next:     Application.ScreenUpdating = False
                            wProgramName = UCase(wProgramName)
Dim cPrograms As New Collection
  Dim OutApp As Object '           Set OutApp = GetObject(, "Outlook.Application")

'' some common program names:
''
' "OUTLOOK.EXE"     to test for Outlook is already running
' "MSACCESS.EXE"    to test if MS Access is already running
' "EXCEL.EXE"       to test for Excel
' "WINWORD.EXE"     to test for Word application
' "POWERPNT.EXE"    to test for Powerpoint
'
' etc.
'
Const wThisPC As String = "."
  Dim objWMIService, colItems, objItem
Dim wName As String
    Set objWMIService = GetObject("winmgmts:\\" & wThisPC & "\root\CIMV2")
    Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process", , 48)

    For Each objItem In colItems
        wName = "":                     wName = UCase(Trim$(objItem.Name))
        cPrograms.Add (wName), CStr(wName)
        'Debug.Print wName, cPrograms.Count
        If wName = wProgramName Then
            IsProgramOpen = True:       Err.Clear
            If OutApp Is Nothing Then
              Set OutApp = GetObject(, "Outlook.Application")
            End If
            If OutApp Is Nothing Then
              Set OutApp = CreateObject("Outlook.application")
            End If
            If OutApp Is Nothing Then
              ' Try to get the new Outlook
              Set OutApp = GetObject(, "Outlook.Application.23")
            End If
            If OutApp Is Nothing Then
              Set OutApp = CreateObject("Outlook.application.23")
            End If
            Exit For
        End If
    Next
End Function

When running the macro I go Until

• isProgramOpen = True
• Err.Clear

So looks like is working fine but I am still not able to refer to OutLook and display Outlook

• Dim OutMail As Object: Set OutMail = OutApp.CreateItem(0)
• OutMail.Display

• Set OutApp does not work despite IsProgramOpen = True:

No matter if I use GetObject , CreateObject, Outlook.application or Outlook.application.23

On vba tools references Outlook 16 is added



So How can I refer to Outllok ???
I do not know what's going on ?


I

 

[JEC]

the new outlook does not work with vba, since it doesn't support COM addins