asked on

Access 2010 vba determine whether Outlook is open

Hi,

I am trying to implement a procedure that alerts a user whether their Outlook is open before using CreateObject("Outlook.Application"). The reason i am doing this is although i am already using CreateObject("Outlook.Application"), if the user does not have outlook open and cancels sending the email, the system hangs.

i have tried using the following as a check before running the send email vba code but this always gives the msgbox that Outlook is open!

Any ideas?

'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
'Outlook is not running, let's open it
msgbox "outlook is not open"
retVal = Shell(conPATH_TO_OUTLOOK, vbMaximizedFocus)
Else
'Outlook is running, I'll leave the rest up to you!
msgbox "outlook is open"
End If

the full send email code is below. This works fine if outlook is open!

Dim strBody As String
Dim strEmail As String
Dim strSubject As String

Dim objOutlook As Object
Dim objMailItem As Object
Const olMailItem As Integer = 0
Set objOutlook = CreateObject("Outlook.Application")
Set objMailItem = objOutlook.CreateItem(olMailItem)

strEmail = strEmailAdd
strSubject = "LIME PII Policy " & Me.PolicyRef
strBody = "Dear " & strContactName & "," & vbCrLf & vbCrLf
strBody = strBody & "Please find attached PII Policy Documents for:" & vbCrLf & vbCrLf
strBody = strBody & "Company Name: " & Me.CompanyName & " - Policy Ref: " & Me.PolicyRef & vbCrLf & vbCrLf
strBody = strBody & "We trust this policy satisfies your requirements." & vbCrLf & vbCrLf
strBody = strBody & "Yours sincerely" & vbCrLf & vbCrLf & vbCrLf
strBody = strBody & strCurrentUser

objMailItem.To = strEmail
objMailItem.Subject = strSubject
objMailItem.Body = strBody
objMailItem.Attachments.Add (strPolicyPath)
objMailItem.Attachments.Add (strWordingAttach)

'objMailItem.Display (True)
'objMailItem.Send

objMailItem.Display True 'make outlook modal
'check if the email was sent or just closed
On Error Resume Next
Dim bSent As Boolean
bSent = objMailItem.Sent 'just used to get a error,
If Err = 0 Then
'no message, email closed, objMailItem still exists
bSent = False
Else
'message sent or saved, objMailItem is null
bSent = True
End If

Set objOutlook = Nothing
Set objMailItem = Nothing

On Error GoTo ErrorHandler

If bSent = True Then
'MsgBox "email was sent...update tables"
strEventText = "Policy saved to client folder and emailed to " & strIssuedTo & ". " & Me!PolicyRef
strMsgBoxText = "Policy saved to client folder and emailed to " & strIssuedTo & "." _
& vbCrLf & vbCrLf & "Please issue a debit note if required."
Else
'MsgBox "email was not sent...do not update tables"
strEventText = "Policy documents saved to client folder but email was cancelled by user. " & Me!PolicyRef
strMsgBoxText = "Policy documents saved to client folder but you cancelled the email."
End If

Gozreh

try changing the code to

   Dim retVal As Variant
   Dim conPATH_TO_OUTLOOK As String
   conPATH_TO_OUTLOOK = SysCmd(acSysCmdAccessDir) & "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

Open in new window

Using the SysCmd(acSysCmdAccessDir) will check which version of office you are using, and if its installed in "Program Files (x86)" or in "Program Files".

ASKER CERTIFIED SOLUTION

Gozreh

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

andrewpiconnect

ASKER

Hi Gozreh,

Your code seem to work in respect of opening outlook with the attachments etc, however, if i cancelled sending the email the system crashes and hangs (have to use task manager to stop access), so i am not better off than originally?

andrewpiconnect

ASKER

okay, what ive done is use your code to alert the user that outlook is closed and exit the sub. This way it forces th user open outlook and then the existing code will not crash and hang if the user cancels sending the email. Do you agree?

On Error Resume Next
Dim objOutlook1 As Object
Set objOutlook1 = GetObject(, "Outlook.Application") ' Determine if Outlook is open
If Err <> 0 Then 'If Not open it
MsgBox "you need to open your Outlook Email CLient in order to send issue this policy.outlook closed....open it"
Set objOutlook1 = Nothing
Exit Sub
'Call Shell(SysCmd(acSysCmdAccessDir) & "OUTLOOK.EXE")
Else
MsgBox "outlook open, ok to proced to issue email code"
Set objOutlook1 = Nothing
End If

continue with existing code here....

Gozreh

is the system crashing only if outlook is closed, if so this code will check if outlook is open and if not it will open it.

andrewpiconnect

ASKER

the system only crashes if:
1) outlook is closed (system then opens email with attachments for user to preview)
2) the user then cancels the send

if the outlook is already open:
1) system opens the email for preview
2) user decides to cancel the send
3) system doesn't crash

Even though your code "Call Shell(SysCmd(acSysCmdAccessDir) & "OUTLOOK.EXE")" seemed to run ok, if the user cancelled the send the system crashed.

I have to have the user preview the email before sending so i think the best work around is to alert the user that outlook is closed, exit the sub until they manually open outlook, this way if they decide to cancel the send for whatever reason, the system will not crash.

andrewpiconnect

ASKER

its strange that even though running:

Call Shell(SysCmd(acSysCmdAccessDir) & "OUTLOOK.EXE")

the system still crashed if the send was cancelled??

Gozreh

and what happens if the user is opening outlook ?

SOLUTION

Gozreh

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

andrewpiconnect

ASKER

exactly.....i should hold the code until the user opens outlook....so i am proposing to use this:

On Error Resume Next
Dim objOutlook1 As Object

Set objOutlook1 = GetObject(, "Outlook.Application") ' Determine if Outlook is open
If Err <> 0 Then 'If Not open it
MsgBox "you need to open your Outlook Email CLient in order to send issue this policy.outlook closed....open it"
Set objOutlook1 = Nothing
Exit Sub
Else
MsgBox "outlook open, ok to proceed to issue email code"
Set objOutlook1 = Nothing
Set objOutlook = CreateObject("Outlook.Application")
Set objMailItem = objOutlook.CreateItem(olMailItem)

rest of email code etc etc

End If