Determine if Outlook Is Open - If Not, Open It

[jtgarrison]

Is there a way to tell if Outlook is open before sending a message and open it if it's not?

I have some old code that I have been using:

'Determine If Outlook Is Open. If Not, Open.
Set objOutlook = GetObject(, "Outlook.Applic ation") ' Determine if Outlook is open.

If Err <> 0 Then
Call Shell("C:\Progr am Files\Microsoft Office\OFFICE12 \OUTLOOK.EXE")
End If

But the problem is...is that even if Outlook is open, the code will open another instance of it, which is not ideally what I want.

Thanks in advance.

Jeff

[jbt007]

Here is some sample code that does just that. Paste the following code at the top of a standard module in any Office program that supports VBA.

Public Enum OfficeAppName
' enums always start from zero, unless otherwise specified
' for demonstration purposes (on the worksheet), start from 1
   Outlook = 1
    PowerPoint = 2
    Excel = 3
    Word = 4
    Publisher = 5
    Access = 6
End Enum
 
Function IsAppRunning(appName As OfficeAppName) As Boolean
' check if a particular Office app is running
 
On Error GoTo NotRunning
 
Dim officeApp As Object
Dim appString As String
 
' assume true
IsAppRunning = True
 
' determine which app is being checked
Select Case appName
    Case 1 ' Outlook
       appString = "Outlook"
    Case 2 ' PowerPoint
       appString = "PowerPoint"
    Case 3 ' Excel
       appString = "Excel"
    Case 4 ' Word
       appString = "Word"
    Case 5 ' Publisher
       appString = "Publisher"
    Case 6 ' Access
       appString = "Access"
End Select
 
' try to hook into existing object
Set officeApp = GetObject(, appString & ".Application")
 
ExitProc:
  Exit Function
 
NotRunning:
  IsAppRunning = False
  Resume ExitProc
 
End Function

To use, just type something like:

Sub TestGet()
  MsgBox IsAppRunning(Outlook)
End Sub

It's not very sophisticated, but it works. You may want to beef up the exit code. On successful "GetObject" , the officeApp will be the application that's running. So you might want to Set officeApp = nothing in the ExitProc.

[jtgarrison]

@jbt007
I placed the code in a module and put the msgbox IsAppRunning(Ou tlook) and go a Compile Error: ByRef argument type mismatch.
Any ideas?

[jbt007]

@jtgarrison
When you copied the code, did you copy it into a new module? Starting just under "Option Compare Database"?
This should put

Public Enum OfficeAppName
' enums always start from zero, unless otherwise specified
' for demonstration purposes (on the worksheet), start from 1
   Outlook = 1
    PowerPoint = 2
    Excel = 3
    Word = 4
    Publisher = 5
    Access = 6
End Enum

In the (declarations) section of the module. You will then have the rest of the code (starting with "Function.. .") in the "IsAppRunni ng" sub.

When you type "IsAppRunni ng(" you should get a drop-down list of "Outlook, PowerPoing, Excel, ..." when you type "(". Is that the case if you type it in the Immediate window?

The message box should pop up with "True" or "False" as the message.

[jtgarrison]

This is what I have:

Option Compare Database
Public Enum OfficeAppName
' enums always start from zero, unless otherwise specified
' for demonstration purposes (on the worksheet), start from 1
   Outlook = 1
    PowerPoint = 2
    Excel = 3
    Word = 4
    Publisher = 5
    Access = 6
End Enum
 
Function IsAppRunning(appName As OfficeAppName) As Boolean
' check if a particular Office app is running
 
On Error GoTo NotRunning
 
Dim officeApp As Object
Dim appString As String
 
' assume true
IsAppRunning = True
 
' determine which app is being checked
Select Case appName
    Case 1 ' Outlook
       appString = "Outlook"
    Case 2 ' PowerPoint
       appString = "PowerPoint"
    Case 3 ' Excel
       appString = "Excel"
    Case 4 ' Word
       appString = "Word"
    Case 5 ' Publisher
       appString = "Publisher"
    Case 6 ' Access
       appString = "Access"
End Select
 
' try to hook into existing object
Set officeApp = GetObject(, appString & ".Application")
 
ExitProc:
  Exit Function
 
NotRunning:
  IsAppRunning = False
  Resume ExitProc
 
End Function

And even in the immediate window, I type msgbox isAppRunning(Ou tlook) and I get the same error.

[jbt007]

Select "Insert","Modul e" from the VBA Editor, then paste the code in just under "Option Compare Database". When you do this, it should put the Enum in the "Declaratio ns" section of the module (See Declarations.jp g attached) and then create a function for "IsAppRunni ng" (See IsAppRunning.jp g attachment). After saving and compiling the code, in the immediate window you should be able to type ?IsAppRunning(O utlook) and hit enter. When you hit the "(" you should get a drop-down list. (see Immediate.jpg also attached)

[ADezii]

The API makes this a relatively simple problem to solve:

'Declaration for the API Function
Declare Function apiFindWindow Lib "user32" Alias "FindWindowA" _
 (ByVal strClassName As String, ByVal lpWindowName As Any) As Long

Dim retVal As Variant
 
'Adjust if necessary
Const conPATH_TO_OUTLOOK As String = "C:\Program Files\Microsoft Office\OFFICE12\OUTLOOK.EXE"
 
 
If apiFindWindow(CStr("rctrl_renwnd32"), 0&) = 0 Then
  MsgBox conPATH_TO_OUTLOOK & " is not running!"
  'Outlook is not running, let's open it
  retVal = Shell(conPATH_TO_OUTLOOK, vbMaximizedFocus)
Else
   'Outlook is running, I'll leave the rest up to you!
  MsgBox conPATH_TO_OUTLOOK & " is running!"
 End If