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
andrewpiconnectAsked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
GozrehConnect With a Mentor Commented:
I found now i'm using this code and it should also work
   On Error Resume Next
   Dim objOutlook As Object
   Set objOutlook = GetObject(, "Outlook.Application") ' Determine if Outlook is open
   If Err <> 0 Then 'If Not open it
      Call Shell(SysCmd(acSysCmdAccessDir) & "OUTLOOK.EXE")
   End If

Open in new window

0
 
GozrehCommented:
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".
0
 
andrewpiconnectAuthor Commented:
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?
0
Easily Design & Build Your Next Website

Squarespace’s all-in-one platform gives you everything you need to express yourself creatively online, whether it is with a domain, website, or online store. Get started with your free trial today, and when ready, take 10% off your first purchase with offer code 'EXPERTS'.

 
andrewpiconnectAuthor Commented:
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....
0
 
GozrehCommented:
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.
0
 
andrewpiconnectAuthor Commented:
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.
0
 
andrewpiconnectAuthor Commented:
its strange that even though running:

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

the system still crashed if the send was cancelled??
0
 
GozrehCommented:
and what happens if the user is opening outlook ?
0
 
GozrehConnect With a Mentor Commented:
So the solution should be, that you should hold the code before
Set objOutlook = CreateObject("Outlook.Application")
                Set objMailItem = objOutlook.CreateItem(olMailItem)
till outlook is open.
0
 
andrewpiconnectAuthor Commented:
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
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.