Galadorn
asked on
Open new mail message via Access VBA problem
Hi Experts,
In an Access 2007 application, I use an onclick event to open a new mail message using the fonction attached.
It works with : SetForegroundWindow (objOutlookMsg) or objApp.Explorers.Item(2).A ctivate but not always.
Very rarely on my computer and often on my customer computer, the new mail message stays background (flashing orange on task bar)
How can I be sure that the new message is Foreground after the onclick subroutine is finished ?
Thanks for your help.
In an Access 2007 application, I use an onclick event to open a new mail message using the fonction attached.
It works with : SetForegroundWindow (objOutlookMsg) or objApp.Explorers.Item(2).A
Very rarely on my computer and often on my customer computer, the new mail message stays background (flashing orange on task bar)
How can I be sure that the new message is Foreground after the onclick subroutine is finished ?
Thanks for your help.
Option Compare Database
Declare Function apiFindWindow Lib "user32" Alias "FindWindowA" (ByVal strClassName As String, ByVal lpWindowName As Any) As Long
Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Sub SendOutlookMessage(strEmailAddress As String, strEmailCCAddress As String, strEmailBccAddress As String, strSubject As String, strMessage As String, blnDisplayMessage As Boolean, Optional strAttachmentFullPath As String)
'* Copy this code and paste it into a new Access
'* Module. Click Tools > References and make sure
'* that "Microsoft Office Outlook x.0 Object Library"
'* is checked.
'*
'* SendOutlookMessage "john@doe.com", "ccJane@doe.com", "bccSue@doe.com", "Subject", "Body of Message", False, "C:\My Documents\MyAttachmentFile.txt"
Dim objApp As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecipient As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim strProcName As String
Const conPATH_TO_OUTLOOK As String = "OUTLOOK.EXE"
On Error Resume Next
strProcName = "SendOutlookMessage"
If apiFindWindow(CStr("rctrl_renwnd32"), 0&) = 0 Then
RetVal = Shell(conPATH_TO_OUTLOOK, vbMaximizedFocus)
Do While apiFindWindow(CStr("rctrl_renwnd32"), 0&) = 0
Loop
End If
Set objApp = GetObject(, "Outlook.Application")
If objApp Is Nothing Then
Set objApp = CreateObject("Outlook.Application")
End If
Set objOutlookMsg = objApp.CreateItem(olMailItem)
With objOutlookMsg
.To = strEmailAddress
.CC = strEmailCCAddress
.BCC = strEmailBccAddress
.subject = strSubject
.Body = strMessage
If Not IsMissing(strAttachmentFullPath) Then
If Trim(strAttachmentFullPath) = "" Then
Else
Set objOutlookAttach = .Attachments.Add(strAttachmentFullPath)
End If
End If
If blnDisplayMessage Then
.Display
Else
.Send
End If
End With
'SetForegroundWindow (objOutlookMsg)
objApp.Explorers.Item(2).Activate
Set objApp = Nothing
Set objOutlookMsg = Nothing
Set objOutlookAttach = Nothing
Set objOutlookRecipient = Nothing
End Sub
Nick.
FWIW, I never experienced this.
Could it have anything to do with outlook not being open when the code is run?
There are a couple of techniques (I am sure you are aware of), that will open outlook, if it is not already open...
Waddaya think?
Jeff
FWIW, I never experienced this.
Could it have anything to do with outlook not being open when the code is run?
There are a couple of techniques (I am sure you are aware of), that will open outlook, if it is not already open...
Waddaya think?
Jeff
I recycle Outlook if it's open, and open it if it is not open
Private Sub CreateAnEmail(BodyText As String, SuccessfulAttachment As Boolean)
On Error Resume Next
Dim db As Database
Dim rs As Recordset
Dim ClientEmail As String
Dim DisplayMsg As Boolean
Dim AttachmentPath As String
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim objOutlookExplorers As Outlook.Explorers
Dim myarray() As String
Dim myaddresses() As String
Dim x As Integer
Dim fs As Object
Dim BuiltPath As String
Dim response As Integer
Dim WasOpen As Boolean
Do While GetPrinterDetails("Adobe PDF").Jobs > 0
DoEvents
Loop
DisplayMsg = True
AttachmentPath = "U:\computer2\ISO Files\Cert Tracking\" & Format(Now(), "dd-mmm-yyyy") & " Weekly Cert Submitted Summary.xls"
Set objOutlook = GetObject(, "Outlook.Application")
'MsgBox Err.Number & " " & Err.Description
If Err.Number = 429 Then
Err.Clear
WasOpen = False
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
Else
WasOpen = True
End If
Dim ns As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder
Set ns = objOutlook.GetNamespace("MAPI")
Set Folder = ns.GetDefaultFolder(olFolderInbox)
Set objOutlookExplorers = objOutlook.Explorers
If WasOpen = False Then
objOutlook.Explorers.Add Folder
Folder.Display
'done opening
End If
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
Set objOutlookRecip = .Recipients.Add("This dude")
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(fGetFullNameOfLoggedUser())
objOutlookRecip.Type = olCC
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Another dude")
objOutlookRecip.Type = olCC
' Add the BCC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Somebody else")
objOutlookRecip.Type = olBCC
' Add the BCC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("and her")
objOutlookRecip.Type = olBCC
' Set the Subject, Body, and Importance of the message.
.Subject = "Weekly Cert Completion Stats"
.Body = BodyText
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
'reportcaption is passed in and split into myarray
'one attachment needs to be added for each element in myarray
'AttachmentPath = "c:\tempPDF\" & myarray(x) & ".pdf"
If SuccessfulAttachment = True Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
'.Save
'.Send
End If
End With
Set objOutlook = Nothing
End Sub
And yet sometimes the email security message hides underneath, and other times it pops over
ASKER
Each time I saw this behavior, Outlook was already opened. But I have to try 10-20 times to see the problem occuring.
Can I set focus on the new mail message when I'm onCurrent event on my form ? Or somewhere else...
Don't kown how to do and if it'll solve the problem.
Can I set focus on the new mail message when I'm onCurrent event on my form ? Or somewhere else...
Don't kown how to do and if it'll solve the problem.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Ok thanks for your help.
I've followed your advice and stop all vba code after the opening of the new mail message and it seems to reduce the problem to the maximum.
I've followed your advice and stop all vba code after the opening of the new mail message and it seems to reduce the problem to the maximum.
I even use API code in trying to bring stuff to the front.
I haven't found anything bulletproof yet.