Emailing Based upon Query Values

Aoife

Registered User.
Local time
Today, 23:14
Joined
Dec 4, 2013
Messages
36
Hi

I've adapted the following code to email a report based on the values of a query. If an individual is ticked, they will receive an email with a report attached. All goes well.... if you have the patience of a saint.

In the event that 1 person is being emailed, it takes approximately 5 seconds. Upon selecting up to 15 recipients, it'll take approx. 60 seconds.

If I populate the names directly into the VBA, it takes approximately 1 second. Is there anything that I can do to refine the process without losing the ability for the user to configure a more accessible circulation list?

Code:
[SIZE=3][FONT=Calibri]'Obtain email addresses from qryEmailRecipients query[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Set db = CurrentDb[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]'Set rs = db.OpenRecordset("qryEmailRecipients")[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Set rs = db.OpenRecordset("SELECT * FROM qryEmailRecipients WHERE [field1] = -1")[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Do While Not rs.EOF[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]  strListEmail = strListEmail & ";" & rs!EmailAddress[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]rs.MoveNext[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Loop[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]strListEmail = Mid(strListEmail, 2)[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]rs.Close[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Set rs = Nothing[/FONT][/SIZE]
 
Apologies

Continued to play about, misinformation re the manually inputting of numerous email addresses straight into the VBA. It takes forever as well so looks like it's not the code that I've posted but the number of recipients.

Using CDO method, avoiding the Outlook prompts etc, to circulate the emails. Is it usually this slow for several recipients?
 
No its normally not slow.

You have not shown the entire code so not possible to say what brakes there might have been built. Show all related code and queries, not just snippets.
 
Great, if something is slowing this down, here goes:

Code:
[FONT=Calibri]Option Compare Database[/FONT]
[FONT=Calibri]Option Explicit[/FONT]
 
[FONT=Calibri]Public Sub EmailFromNMQuery()[/FONT]
[FONT=Calibri]Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.[/FONT]
[FONT=Calibri]Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).[/FONT]
[FONT=Calibri]Const cdoAnonymous = 0 'Do not authenticate[/FONT]
[FONT=Calibri]Const cdoBasic = 1 'basic (clear-text) authentication[/FONT]
[FONT=Calibri]Const cdoNTLM = 2 'NTLM[/FONT]
 
[FONT=Calibri]Dim strOutputDir As String[/FONT]
[FONT=Calibri]Dim strDefaultDB As String[/FONT]
[FONT=Calibri]Dim strReportName2 As String[/FONT]
[FONT=Calibri]Dim strReportName4 As String[/FONT]
[FONT=Calibri]Dim db As DAO.Database[/FONT]
[FONT=Calibri]Dim rs As DAO.Recordset[/FONT]
[FONT=Calibri]Dim strListEmail As String[/FONT]
[FONT=Calibri]Dim objMessage As Object[/FONT]
 
[FONT=Calibri]'Lets users know system is doing something[/FONT]
[FONT=Calibri]DoCmd.Hourglass True[/FONT]
 
[FONT=Calibri]'Get current value of default directory ie where access stores files on PC, so that you can reset it after[/FONT]
[FONT=Calibri]   'you are finished[/FONT]
[FONT=Calibri]   strDefaultDB = GetOption("Default Database Directory")[/FONT]
 
[FONT=Calibri]   'Set the output directory to YOUR_DIRECTORY_HERE[/FONT]
[FONT=Calibri]   strOutputDir = "\\aaa \bbb\ccc\ddd\eee\ffff\"[/FONT]
 
 
[FONT=Calibri]'this line ie strReportName4 ensures pdf output file doesn't go to where the attachment was attached from[/FONT]
[FONT=Calibri]strReportName4 = strOutputDir & "NM Report.pdf"[/FONT]
 
[FONT=Calibri]Set objMessage = CreateObject("CDO.Message")[/FONT]
 
[FONT=Calibri]'Obtain email addresses from qryEmailRecipients query[/FONT]
[FONT=Calibri]Set db = CurrentDb[/FONT]
[FONT=Calibri]Set rs = db.OpenRecordset("SELECT * FROM qryEmailRecipients WHERE [field1] = -1")[/FONT]
 
[FONT=Calibri]Do While Not rs.EOF[/FONT]
[FONT=Calibri]   strListEmail = strListEmail & ";" & rs!EmailAddress   [/FONT]
[FONT=Calibri]rs.MoveNext[/FONT]
[FONT=Calibri]Loop[/FONT]
 
[FONT=Calibri]strListEmail = Mid(strListEmail, 2)[/FONT]
 
[FONT=Calibri]rs.Close[/FONT]
[FONT=Calibri]Set rs = Nothing[/FONT]
 
 
[FONT=Calibri]'Throw info into email[/FONT]
[FONT=Calibri]          objMessage.Subject = "NM Report"[/FONT]
[FONT=Calibri]objMessage.FROM = """NM Report"" <test@abc.co.uk>"[/FONT]
[FONT=Calibri]objMessage.To = strListEmail 'NOTE: Internal emails only.[/FONT]
[FONT=Calibri]objMessage.cc = " beta@abc.co.uk; beta@abc.co.uk ; beta@abc.co.uk ; beta@abc.co.uk ; beta@abc.co.uk ; beta@abc.co.uk ; beta@abc.co.uk ; beta@abc.co.uk ; beta@abc.co.uk " ‘Entered emails in here for testing purposes.  Leave one in here to avoid empty recordset in query[/FONT]
 
[FONT=Calibri]objMessage.textbody = "A NM Report has been completed" & vbCrLf & vbCrLf & "Please find report attached" & vbCrLf & "This is an automated message - please do not reply"[/FONT]
[FONT=Calibri]'Attachment here[/FONT]
[FONT=Calibri]DoCmd.OutputTo acOutputReport, "NMreport", acFormatPDF, strReportName4, False[/FONT]
 
[FONT=Calibri]'Concatenates 2 variables above to capture file from NM folder on network[/FONT]
[FONT=Calibri]objMessage.AddAttachment strOutputDir & "NM Report.pdf"[/FONT]
[FONT=Calibri]   SetOption "Default Database Directory", strDefaultDB[/FONT]
 
[FONT=Calibri]'==This section provides the configuration information for the remote SMTP server.[/FONT]
 
[FONT=Calibri]objMessage.Configuration.Fields.Item _[/FONT]
[FONT=Calibri]("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2[/FONT]
[FONT=Calibri]'Name or IP of Remote SMTP Server[/FONT]
[FONT=Calibri]objMessage.Configuration.Fields.Item _[/FONT]
[FONT=Calibri]("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "xxx-xxxx"[/FONT]
[FONT=Calibri]'Server port (typically 25)[/FONT]
[FONT=Calibri]objMessage.Configuration.Fields.Item _[/FONT]
[FONT=Calibri]("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25[/FONT]
[FONT=Calibri]'Use SSL for the connection (False or True)[/FONT]
[FONT=Calibri]objMessage.Configuration.Fields.Item _[/FONT]
[FONT=Calibri]("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False[/FONT]
[FONT=Calibri]'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)[/FONT]
[FONT=Calibri]objMessage.Configuration.Fields.Item _[/FONT]
[FONT=Calibri]("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60[/FONT]
[FONT=Calibri]objMessage.Configuration.Fields.Update[/FONT]
[FONT=Calibri]'==End remote SMTP server configuration section==[/FONT]
[FONT=Calibri]           objMessage.Send[/FONT]
[FONT=Calibri]         MsgBox "Thank you, your report has been submitted", vbInformation[/FONT]
[FONT=Calibri]           DoCmd.Hourglass False[/FONT]
 
[FONT=Calibri]Set db = Nothing[/FONT]
[FONT=Calibri]Set rs = Nothing[/FONT]
[FONT=Calibri]End Sub[/FONT]
 
I can't see anything which would slow the operation in the way you describe.

I suggest you put some break points in your code to isolate just where the speed bump is.
 
The code surprisingly zips right through to the following line in about one second (upon attempting to sending to 6 email recipients.

Code:
[FONT=Calibri]objMessage.Send[/FONT]

Putting a break on the following line and the code takes approximately 25 seconds to run

Code:
          MsgBox "Thank you, your report has been submitted", vbInformation

Any other thoughts on the matter or should I be approaching my IT department in relation to our mail server?
 
Anyone else experience this sort of behaviour? Wondering if I could get some pointers for the IT crowd
 
You still haven't shown everything: what is qryEmailRecipients
 
Besides, use Now() to get the time, - insert

debug.print now()

here and there, and see where the largest time difference is.
 
Hi again

I've stripped the reliance on qryEmailRecipients (query containing list of email recepients) out of the equation and also the attachment. I've simply put 6 email addresses (all the same addresses) into the 'To' and CC lines of the code.

To formalise what I've already outlined, but in a less professional fashion to your Debug.Print Now() approach, the following times were logged:

25/10/2015 20:39:08
25/10/2015 20:39:39

The code took approximately 2 secs to get to the penultimate Debug.Print (shown below) and 31 seconds to 'objMessage.Send'. :banghead:



Code:
Debug.Print Now()
            objMessage.Send
          Debug.Print Now()
 
IT have finally come back. Due to me testing the code using my email address several times for testing purposes, our email server didn't take kindly to it having the same email address in the 'To' and 'cc' lines.

It was simple as that, it's now really slick - apologies for this, I did pick up some really good tips on debugging etc and hopefully it may enlighten others in a similar situation.

Thank you
 

Users who are viewing this thread

Back
Top Bottom