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!
'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)
'Outlook is running, I'll leave the rest up to you!
msgbox "outlook is open"
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.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
'message sent or saved, objMailItem is null
bSent = True
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."
'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."