Excel VBA to detect if Outlook is open, if its not ,then open it

Question

I have written code to download an attachment to a specified folder.

Const olFolderInbox = 6

Sub detectpp_plate_record1()

Dim oOutlook As Object
Dim oOlns As Object
Dim oOlInb As Object
Dim unRead, m As Object, att As Object

'~~> Get Outlook instance
Set oOutlook = GetObject(, "Outlook.application")
Set oOlns = oOutlook.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

'~~> Check if there are any actual unread emails
Set unRead = oOlInb.Items.Restrict("[UnRead] = True")

' File_Path = "D:\Attach\"

File_Path = "C:\Users\Desktop\pocket setter excel\"

If unRead.Count = 0 Then
    MsgBox "NO Unread Email In Inbox"
Else
    For Each m In unRead
        If m.Attachments.Count > 0 Then
            For Each att In m.Attachments
                If att.Filename Like "plate record*" Then
                    MsgBox "Unread Email with attachment available In Inbox"
                   
                    'Like "plate record*.xls"
                    '~~> Download the attachment
                    ' to the file path and file name
                    'att.Filename = name of attachement
                        
                    att.SaveAsFile File_Path & "plate record"
                            
                    'att.SaveAsFile File_Path & att.Filename
                            
                    '& Format(plate record)
                            
                    ' mark attachment as read               
                    m.unRead = False
                    DoEvents
                    m.Save
               
                    WorkFile = Dir(File_Path & "*")

                    Do While WorkFile <> ""

                       If Right(WorkFile, 4) <> "xlsm" Then
                          Workbooks.Open Filename:=File_Path & WorkFile
                          ActiveWorkbook.SaveAs Filename:= _
                            File_Path & WorkFile & "", FileFormat:= _
                            xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
                          ActiveWorkbook.Close
                          Kill File_Path & WorkFile
                        End If

                        WorkFile = Dir()
                    Loop

                    Exit Sub
                End If
            Next att
        End If
    Next m
End If
End Sub

The problem : This can be executed only when Outlook is open.

Therefore I have to separately open Outlook.

My requirement is to use Excel VBA code to detect if Outlook is open, if it is not, then it should be opened.

---------------------UDATE-----------------------

I combined the above code with the following code.

#Const LateBind = True

Const olMinimized As Long = 1
Const olMaximized As Long = 2
Const olFolderInbox As Long = 6

Sub detectpp_plate_record()
    MyMacroThatUseOutlook
    detectpp_plate_record1
End Sub

#If LateBind Then

Public Function OutlookApp( _
    Optional WindowState As Long = olMinimized, _
    Optional ReleaseIt As Boolean = False _
    ) As Object
    Static oOutlook As Object
#Else
Public Function OutlookApp( _
    Optional WindowState As Outlook.OlWindowState = olMinimized, _
    Optional ReleaseIt As Boolean _
) As Outlook.Application
    Static oOutlook As Outlook.Application
#End If
On Error GoTo ErrHandler
 
    Select Case True
        Case oOutlook Is Nothing, Len(oOutlook.name) = 0
            Set oOutlook = GetObject(, "Outlook.Application")
            If oOutlook.Explorers.Count = 0 Then
InitOutlook:
                'Open inbox to prevent errors with security prompts
                oOutlook.Session.GetDefaultFolder(olFolderInbox).Display
                oOutlook.ActiveExplorer.WindowState = WindowState
            End If
        Case ReleaseIt
            Set oOutlook = Nothing
    End Select
    Set OutlookApp = oOutlook
 
ExitProc:
    Exit Function
ErrHandler:
    Select Case Err.Number
        Case -2147352567
            'User cancelled setup, silently exit
            Set oOutlook = Nothing
        Case 429, 462
            Set oOutlook = GetOutlookApp()
            If oOutlook Is Nothing Then
                Err.Raise 429, "OutlookApp", "Outlook Application does not appear to be installed."
            Else
                Resume InitOutlook
            End If
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Unexpected error"
    End Select
    Resume ExitProc
    Resume
End Function

#If LateBind Then
Private Function GetOutlookApp() As Object
#Else
Private Function GetOutlookApp() As Outlook.Application
#End If
On Error GoTo ErrHandler
    
    Set GetOutlookApp = CreateObject("Outlook.Application")
    
ExitProc:
    Exit Function
ErrHandler:
    Select Case Err.Number
        Case Else
            'Do not raise any errors
            Set GetOutlookApp = Nothing
    End Select
    Resume ExitProc
    Resume
End Function

Sub MyMacroThatUseOutlook()
    Dim OutApp  As Object
    Set OutApp = OutlookApp()
    'Automate OutApp as desired
End Sub

 

Now, if Outlook is open the code searches for the specified unread email.

If Outlook is closed, it opens it, but afterwards there is an error

Run time error 429:

ActiveX component cant create object.

Therefore once again I have to click on button for the code to search for the specified emails.

How do I get rid of this error and perform this in one go?

Answer 1

Add this to your code:

Dim oOutlook As object

    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")
    On Error Goto 0 

    If oOutlook Is Nothing Then
        Set oOutlook = CreateObject("Outlook.Application")
    End If

I tried and tested it . It works.

Answer 2

Something like this:-

Set oOutlook = GetObject(, "Outlook.application")
If oOutlook is nothing Then
  'outlook is not running so start it
  set oOutlook = New Outlook.Application
Else
' outlook is running
End If