Test if outlook is open

[idono]

Hello all,
Can anyone show me a way to test if Outlook is open. If it is not I want to open it and send my message. If it is with the code I have I can start an object and send my message. The code I have only works if outlook is already open. Currently I only know how to open up a new application using shell.

Dim objOutLook As Object
Dim objOutlookMsg As Object
Dim objOutlookRecip As Object
Dim objOutlookAttach As String

Set objOutLook = CreateObject("Outlook.Application&quot
Set objOutlookMsg = objOutLook.CreateItem(olMailItem)

objOutlookAttach = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name

With objOutlookMsg
.Recipients.Add "Whoever@anywhere.com"
.CC = msgCC
.Subject = "Just a test!"
.Body = msgBody
.Attachments.Add objOutlookAttach
If ImportanceHigh = False Then
.Importance = olImportanceNormal
Else
.Importance = olImportanceHigh
End If

'Resolving the message removes all invalid e-mail address, this will handle up to 5 invalid email addresses
Dim i As Integer
i = 1
Do While i < 5
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookRecip.Delete
End If
Next
i = i + 1
Loop

If SendNow = False Then
.Display (False)
ElseIf SendNow = True Then
.Send
End If
End With
Set objOutlookMsg = Nothing
Set objOutLook = Nothing

Any help would be appreciated!
Dugger

 

[scking]

The easy way is to use GetObject and if gives an error handle it.

On Error Resume Next
Set objOutLook = CreateObject(&quot;Outlook.Application&quot
If Err.Number <> 0 Then
' Outlook isn't open so open it
Set objOutLook = CreateObject(&quot;Outlook.Application&quot
End If
On Error GoTo HandleErr


----------------------
scking@arinc.com
Life is filled with lessons.
We are responsible for the
results of the quizzes.
-----------------------

 

[jnicks]

hullo sc

are both lines supposed to be identical?

Set objOutLook = CreateObject(&quot;Outlook.Application&quot

Set objOutLook = CreateObject(&quot;Outlook.Application&quot

Looks od, and why would the first errortrap and not the second, or if both do . . .

I know it may be something simple I am missing.

 

[scking]

My error. That's what I get for not having a proofreading. Another reason testers thrive. Replace the first with:

Set objOutLook = GetObject(&quot;Outlook.Application&quot

Which uses sets an object from the Open applications. If, and when, it fails you take the appropriate steps.

On Error Resume Next
Set objOutLook = GetObject(&quot;Outlook.Application&quot
If Err.Number <> 0 Then
' Outlook isn't open so open it
Set objOutLook = CreateObject(&quot;Outlook.Application&quot
End If
On Error GoTo HandleErr

----------------------
scking@arinc.com
Life is filled with lessons.
We are responsible for the
results of the quizzes.
-----------------------

 

[idono]

scking,
It still only works when outlook is already open. I must be doing something wrong. The err.Description that is returned is &quot;Internal Application Error&quot;. It always bombs out on the Set objOutlookMsg = objOutLook.CreateItem(olMailItem) if outlook is not open. Do you have anymore ideas?

Public Function SendEmail(msgTO As String, Optional msgCC As String, Optional msgSubject As String, Optional msgBody As String, Optional ImportanceHigh As Boolean = False, Optional SendNow As Boolean = True)
Dim objOutLook As Object
Dim objOutlookMsg As Object
Dim objOutlookRecip As Object
Dim objOutlookAttach As String

On Error Resume Next
Set objOutLook = GetObject(&quot;Outlook.Application&quot
If Err.Number <> 0 Then
'Outlook isn't open so open it
Set objOutLook = CreateObject(&quot;Outlook.Application&quot
End If
On Error GoTo HandleErr
'objOutLook.Visible = True

Set objOutlookMsg = objOutLook.CreateItem(olMailItem)

With objOutlookMsg
.Recipients.Add &quot;anyone@anywhere.com&quot;
.CC = msgCC
.Subject = &quot;Just a test!&quot;
.Body = &quot;ECN number &quot; & frmMain.txtECN.Text & &quot; has been closed.&quot; & _
vbCrLf & &quot;Attached you will find a link to the web document.&quot; & _
vbCrLf & vbCrLf & &quot;

http://anydoc.html&quot;

.Attachments.Add objOutlookAttach
If ImportanceHigh = False Then
.Importance = olImportanceNormal
Else
.Importance = olImportanceHigh
End If

'Resolving the message removes all invalid e-mail address, this will handle up to 5 invalid email addresses
Dim i As Integer
i = 1
Do While i < 5
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookRecip.Delete
End If
Next
i = i + 1
Loop

If SendNow = False Then
.Display (False)
ElseIf SendNow = True Then
.Send
End If
End With

Set objOutlookMsg = Nothing
Set objOutLook = Nothing

HandleErr_Exit:
Exit Function

HandleErr:
MsgBox Err.Description
Resume HandleErr_Exit

End Function

 

[scking]

Sorry but I've been on travel. It sounds like you don't have a reference set for Outlook and your code seems to support that assumption.

Change this:
Dim objOutLook As Object
To this:
Dim objOutlook As Outlook.Application

If you are unable to get Intellisense to prompt you with 'Outlook' then you haven't set a reference to the Outlook library. Open a module in design mode, go to tools/references and select the reference library for Microsoft Outlook.
----------------------
scking@arinc.com
Life is filled with lessons.
We are responsible for the
results of the quizzes.
-----------------------