UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Automate Emails From Query Results, Access 2016    
 
   
EMDS98
post Apr 25 2019, 10:27 AM
Post#1



Posts: 8
Joined: 25-April 19



OVERVIEW: We have many companies providing us service on more than 1 work order in many cases. Each work order is a row of DATA in a master table (tblMajorRepairData). I've created a Query "qryAutomateEmails" that will filter the records that need to be emailed. I need to send emails for updates on these work orders to each company daily, but I would like to send 1 email to each company containing an excel spreadsheet with all the work orders the currently have open in our system. I also need to update a table, tblMajorRepairData with a new "fldStatus" ("Automated Email Sent") and "fldNextUpdate" with the current time ( Now() ).

I haven't found code that does what I need. Any help will be greatly appreciated.
Go to the top of the page
 
Minty
post Apr 25 2019, 10:37 AM
Post#2



Posts: 298
Joined: 5-July 16
From: UK - Wiltshire


Google is your friend https://www.devhut.net/2016/07/07/vba-automating-excel/

This will be a good start for you. If you get stuck ask back here Daniel is a member of this forum.
Go to the top of the page
 
jleach
post Apr 25 2019, 11:19 AM
Post#3


UtterAccess Editor
Posts: 9,991
Joined: 7-December 09
From: St Augustine, FL


Also check in our Code Archive here for an entry by CheekyBuddha (David) for Sending Emails with CDO - this can be used to send emails without relying on Outlook automation (which is the uninitiated's usual first choice, but the poorest one there is, IMO).

--------------------
Go to the top of the page
 
EMDS98
post Apr 25 2019, 12:13 PM
Post#4



Posts: 8
Joined: 25-April 19



I appreciate you speedy responses. I guess the main thing I need help with is how to send one email to each company (that includes all work orders) rather than an email for each record (work order). Below is my current code.

CODE
Private Sub cmdAutomateEmails_Click()

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    
    Dim emailTo As String
    Dim emailSubject As String
    Dim emailText As String


    Dim outApp As Outlook.Application
    Dim outMail As Outlook.MailItem
    Dim outlookStarted As Boolean
        
    
    On Error Resume Next
    Set outApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If outApp Is Nothing Then
        Set outApp = CreateObject("Outlook.Application")
        outlookStarted = True
    End If

    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT District, ROnum, UnitNum, SPName,EmailAddr " & _
                                " FROM qryAutomateEmails")
    Do Until rs.EOF

        emailTo = "<" & rs.Fields("EmailAddr").Value & ">"
                    
        emailSubject = "Test Subject"
        
        emailText = rs.Fields("ROnum").Value & vbCrLf

                    
        Set outMail = outApp.CreateItem(olMailItem)
        outMail.To = emailTo
        outMail.Subject = emailSubject
        outMail.Body = emailText
        outMail.send

        rs.MoveNext
    Loop
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing

    
    If outlookStarted Then
        outApp.Quit
    End If
    
    Set outMail = Nothing
    Set outApp = Nothing
    
End Sub
Go to the top of the page
 
MadPiet
post Apr 25 2019, 01:27 PM
Post#5



Posts: 3,057
Joined: 27-February 09



You need one recordset for recipients, and another for the work orders belonging to that recipient.

Here's some nice airy air code for you Basically, you have an outer Recipients loop and then an inner WorkOrders loop.

while not rsRecipients.EOF
'create a new email
set rsWorkOrders = CurrentDB.OpenRecordset "SELECT... FROM WorkOrders WHERE CompanyID = " & rsRecipients.Fields("CompanyID").Value
'process work Orders...
' add them to e-mail or something...
while not EOF rsWorkOrders
'add the info from work orders to the e-mail
rsWorkOrders.MoveNext
loop 'Work orders
rsWorkOrders.Close
rsRecipients.MoveNext
Loop '--Recipients
Go to the top of the page
 
EMDS98
post Apr 25 2019, 02:06 PM
Post#6



Posts: 8
Joined: 25-April 19



Ok, that is starting to make sense but I'm not quite sure how to add it to my code. Are you able to show me how it should look?
Go to the top of the page
 
EMDS98
post May 3 2019, 07:27 AM
Post#7



Posts: 8
Joined: 25-April 19



Can anyone help with editing the above code so that 1 email is sent to each company containing all records with the same company name and the records are added to the body of the email?
Go to the top of the page
 
cheekybuddha
post May 3 2019, 07:55 AM
Post#8


UtterAccess VIP
Posts: 11,187
Joined: 6-December 03
From: Telegraph Hill


What is the SQL of qryAutomateEmails ?

Please also describe the tables involved in qryAutomateEmails (field names and datatypes, which field is Primary Key, etc)

--------------------


Regards,

David Marten
Go to the top of the page
 
EMDS98
post May 3 2019, 12:22 PM
Post#9



Posts: 8
Joined: 25-April 19





qryAutomateEmails
CODE
SELECT MajorRepairData.District, MajorRepairData.[RO #] AS ROnum, MajorRepairData.[Unit #] AS UnitNum, MajorRepairData.Status, MajorRepairData.WorkOrderNumber, MajorRepairData.RepairNotes, MajorRepairData.ETC, SPListandRates.[ID #], SPListandRates.[Service Provider Name] AS SPName, SPListandRates.[Email Address] AS EmailAddr
FROM MajorRepairData INNER JOIN SPListandRatesON MajorRepairData.[Map #] = SPListandRates.[ID #]
WHERE (((MajorRepairData.NextUpdate)>=Now()))
GROUP BY MajorRepairData.District, MajorRepairData.[RO #], MajorRepairData.[Unit #], MajorRepairData.Status, MajorRepairData.WorkOrderNumber, MajorRepairData.RepairNotes, MajorRepairData.ETC, SPListandRates.[ID #], SPListandRates.[Service Provider Name], SPListandRates.[Email Address], MajorRepairData.[RO #], MajorRepairData.[Unit #], SPListandRates.[Service Provider Name], SPListandRates.[Email Address]
ORDER BY SPListandRates.[Service Provider Name], SPListandRates.[Email Address];


Main Data Table: MajorRepairData (Primary Key [WorkOrderNumber](Short Text))
Required Fields/Data Type: [RO #](Number), [Unit #](Short Text), [District](Short Text), [ETC](Short Text), [RepairNotes](Short Text), [NextUpdate](Date/Time),[Map #](Number)

Table: SPListandRates (Primary Key [ID #](AutoNumber))
Required Fields/Data Type: [ID #], [Service Provider Name](Short Text), [EmailAddress](Short Text)

I'm trying to send all the records (with the Required Fields listed above) from "MajorRepairData" in the body of an email where [MajorRepairData].[Map #] matches [SPListandRates].[ID #]
Go to the top of the page
 
MadPiet
post May 3 2019, 12:43 PM
Post#10



Posts: 3,057
Joined: 27-February 09



QUOTE
I'm trying to send all the records (with the Required Fields listed above) from "MajorRepairData" in the body of an email where [MajorRepairData].[Map #] matches [SPListandRates].[ID #]


So get that information and return it as something like a Word table? I have done it before, but not in a long time... but I'm sure there's code out there for it. In a nutshell, you'd have to loop through a table of Recipients, and then pass the RecipientID to the "MajorRepairData" query (as a filter) and then that will return a bunch of records, which you then format like a table and drop into your e-mail.
Go to the top of the page
 
MadPiet
post May 3 2019, 02:00 PM
Post#11



Posts: 3,057
Joined: 27-February 09



if you could post a database with DUMMY data, I could probably bang this together in 15 mins. I used to work in healthcare, so please, just FAKE data.

In a nutshell, you get a list of unique recipients. (Say you're looking for all Customers with outstanding invoices... then it's something like

SELECT c.CustomerID, c.CustomerName, c.EMail
FROM Customer c
WHERE EXISTS (SELECT 1 FROM Invoice I WHERE i.CustomerID = c.CustomerID AND i.InvoicePaidDate IS NULL);

Then you would have a list of customers that have outstanding invoices (Yeah, the query is kinda lame, but I wanted it to be simple). Then you open a recordset of those emailaddresses/CustomerIDs and get the unpaid Invoices that belong to them.

SELECT …
FROM Invoice I
WHERE i.CustomerID = rsCustomers.Fields("CustomerID")
AND i.InvoicePaidDate IS NULL

Then you convert that to a table and drop it into your email. Simple, right?
Go to the top of the page
 
EMDS98
post May 6 2019, 08:48 AM
Post#12



Posts: 8
Joined: 25-April 19



Yes the concept is simple but I'm having a hard time getting this code to do what I want. I actually want to list the DATA in the body of the email, for some reason many of the people we email to are not familiar with excel and it actually prevents us from getting updates from them. I really appreciate the help on this. I attached a sample database with fake DATA.
Attached File(s)
Attached File  AutomateEmailsTest.zip ( 23.84K )Number of downloads: 8
 
Go to the top of the page
 
cheekybuddha
post May 7 2019, 09:21 AM
Post#13


UtterAccess VIP
Posts: 11,187
Joined: 6-December 03
From: Telegraph Hill


Hi,

You seem to have the following fields duplicated in your GROUP BY clause:
CODE
MajorRepairData.[RO #], MajorRepairData.[Unit #], SPListandRates.[Service Provider Name], SPListandRates.[Email Address]


Piet will probably come up with a good suggestion, but I think you an get a list of customers to email with a query like:
CODE
SELECT DISTINCT
  r.[Email Address] AS EmailAddr
FROM MajorRepairData d
INNER JOIN SPListandRates r
        ON d.[Map #] = r.[ID #]
WHERE d.NextUpdate >= Now();

Then, you can use code like:
CODE
Private Sub cmdAutomateEmails_Click()

    Dim db As DAO.Database
    Dim rs As DAO.Recordset, rsDets As DAO.Recordset
    Dim strSQL As String
    
    Dim emailTo As String
    Dim emailSubject As String
    Dim emailText As String

    Dim outApp As Outlook.Application
    Dim outMail As Outlook.MailItem
    Dim outlookStarted As Boolean
    
    On Error Resume Next
    Set outApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If outApp Is Nothing Then
        Set outApp = CreateObject("Outlook.Application")
        outlookStarted = True
    End If

    Set db = CurrentDb
    strSQL = "SELECT DISTINCT " & _
             "r.[Email Address] AS EmailAddr " & _
             "FROM MajorRepairData d " & _
             "INNER JOIN SPListandRates r " & _
             "ON d.[Map #] = r.[ID #] " & _
             "WHERE d.NextUpdate >= Now();"
    Set rs = db.OpenRecordset(strSQL)
    Do Until rs.EOF
        emailTo = "<" & .Fields("EmailAddr") & ">"
        emailSubject = "Test Subject"
        emailText = vbNullString
        strSQL = "SELECT District, ROnum, UnitNum, SPName FROM qryAutomateEmails WHERE EmailAddr = '" & emailTo & "';"
        Set rsDets = db.OpenRecordset(strSQL)
        With rsDets
            Do Until .EOF
                emailText = emailText & .Fields("District") & ", " & .Fields("ROnum") & ", " & .Fields("UnitNum") & ", " & .Fields("SPName") & vbNewLine
                .MoveNext
            Loop
            .Close
        End With
        Set outMail = outApp.CreateItem(olMailItem)
        outMail.To = emailTo
        outMail.Subject = emailSubject
        outMail.Body = emailText
        outMail.send
        Set outMail = Nothing
        .MoveNext
    Loop
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing

    If outlookStarted Then
        outApp.Quit
    End If
    
    Set outMail = Nothing
    Set outApp = Nothing
    
End Sub

(Untested, of course!!!)

hth,

d

--------------------


Regards,

David Marten
Go to the top of the page
 
EMDS98
post May 7 2019, 03:29 PM
Post#14



Posts: 8
Joined: 25-April 19



Thanks David! I have it working where it will only send 1 email per email address but I'm not getting anything in the body of the email. I do have the necessary fields added to the query. Below is the current code I'm using:

CODE
Set rsDets = db.OpenRecordset(strSQL)
        With rsDets
            Do Until .EOF
                emailText = emailText & rsDets.Fields("District") & ", " & rsDets.Fields("RO #") & ", " & rsDets.Fields("Unit #") & ", " & rsDets.Fields("Service Provider Name") & vbNewLine
                .MoveNext
            Loop
            .Close
        End With
        Set outMail = outApp.CreateItem(olMailItem)
        outMail.To = emailTo
        outMail.Subject = emailSubject
        outMail.Body = emailText & "Testing"
        outMail.send
        Set outMail = Nothing
        rs.MoveNext
    Loop
Go to the top of the page
 
cheekybuddha
post May 7 2019, 03:57 PM
Post#15


UtterAccess VIP
Posts: 11,187
Joined: 6-December 03
From: Telegraph Hill


As a test, try running with this:
CODE
' ...
        With rsDets
            Do Until .EOF
                emailText = emailText & rsDets.Fields("District") & ", " & rsDets.Fields("RO #") & ", " & rsDets.Fields("Unit #") & ", " & rsDets.Fields("Service Provider Name") & vbNewLine
                .MoveNext
            Loop
            .Close
           Debug.Print emailTo, "Recs: " & .RecordCount
        End With
' ...

Then check the Immediate Window (Ctrl+G) and report back whether you are getting any records for each email address.

... Of course, I have just realised that you added '<...>' around each email address, so there won't be any matches in the recordset!!!

Revise your code to:
CODE
Private Sub cmdAutomateEmails_Click()

    Dim db As DAO.Database
    Dim rs As DAO.Recordset, rsDets As DAO.Recordset
    Dim strSQL As String
    
    Dim emailTo As String
    Dim emailSubject As String
    Dim emailText As String

    Dim outApp As Outlook.Application
    Dim outMail As Outlook.MailItem
    Dim outlookStarted As Boolean
    
    On Error Resume Next
    Set outApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If outApp Is Nothing Then
        Set outApp = CreateObject("Outlook.Application")
        outlookStarted = True
    End If

    Set db = CurrentDb
    strSQL = "SELECT DISTINCT " & _
             "r.[Email Address] AS EmailAddr " & _
             "FROM MajorRepairData d " & _
             "INNER JOIN SPListandRates r " & _
             "ON d.[Map #] = r.[ID #] " & _
             "WHERE d.NextUpdate >= Now();"
    Set rs = db.OpenRecordset(strSQL)
    Do Until rs.EOF
        emailTo = .Fields("EmailAddr")
        emailSubject = "Test Subject"
        emailText = vbNullString
        strSQL = "SELECT District, ROnum, UnitNum, SPName FROM qryAutomateEmails WHERE EmailAddr = '" & emailTo & "';"
        Set rsDets = db.OpenRecordset(strSQL)
        With rsDets
            Do Until .EOF
                emailText = emailText & rsDets.Fields("District") & ", " & rsDets.Fields("RO #") & ", " & rsDets.Fields("Unit #") & ", " & rsDets.Fields("Service Provider Name") & vbNewLine
                .MoveNext
            Loop
            .Close
        End With
        Set outMail = outApp.CreateItem(olMailItem)
        outMail.To = "<" & emailTo & ">"
        outMail.Subject = emailSubject
        outMail.Body = emailText
        outMail.send
        Set outMail = Nothing
        .MoveNext
    Loop
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing

    If outlookStarted Then
        outApp.Quit
    End If
    
    Set outMail = Nothing
    Set outApp = Nothing
    
End Sub


Hopefully you should be good to go now! thumbup.gif

d

--------------------


Regards,

David Marten
Go to the top of the page
 
EMDS98
post May 8 2019, 12:20 PM
Post#16



Posts: 8
Joined: 25-April 19



Good catch... I totally missed that. It is working perfect now. I really appreciate your help on this. Below is the final code I'm using:

CODE
Private Sub cmdAutomateEmails_Click()

    Dim db As DAO.Database
    Dim rs1 As DAO.Recordset, rs2 As DAO.Recordset
    Dim strSQL As String
    
    Dim emailTo As String
    Dim emailSubject As String
    Dim emailText As String
    Dim xSPName As String
    Dim xIntro As String
    Dim xSignature As String
    Dim xArea As String

    Dim outApp As Outlook.Application
    Dim outMail As Outlook.MailItem
    Dim outlookStarted As Boolean
    
    On Error Resume Next
    Set outApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If outApp Is Nothing Then
        Set outApp = CreateObject("Outlook.Application")
        outlookStarted = True
    End If

    Set db = CurrentDb
    'strSQL = "SELECT DISTINCT r.[Email Address] AS EmailAddr, d.[RO #], d.[Unit #], r.[Service Provider Name], d.District" & _
    '"FROM MajorRepairData AS d INNER JOIN SPListandRatesTESTING AS r ON d.[Map #] = r.[ID #]" & _
    '"WHERE (((d.nextupdate) >= Now()))" & _
    '"GROUP BY r.[Email Address], d.[RO #], d.[Unit #], r.[Service Provider Name], d.District;"
    
      strSQL = "SELECT DISTINCT " & _
             "r.[Email Address] AS EmailAddr " & _
             "FROM MajorRepairData d " & _
             "INNER JOIN SPListandRatesTESTING r " & _
             "ON d.[Map #] = r.[ID #] " & _
             "WHERE d.NextUpdate >= Now();"
            
    Set rs1 = db.OpenRecordset(strSQL)
    Do Until rs1.EOF
        emailTo = rs1.Fields("EmailAddr")
        emailSubject = "Update Request " & Now()
        emailText = vbNullString
        strSQL = "SELECT District, [RO #], [UnitNum], [Service Provider Name], [VIN],[Area] FROM qryAutomateEmails WHERE EmailAddr = '" & emailTo & "';"
        Set rs2 = db.OpenRecordset(strSQL)
        With rs2
            Do Until .EOF
                emailText = emailText & "Unit #: " & rs2.Fields("UnitNum") & ", " & "VIN: " & rs2.Fields("VIN") & ", " & "District #: " & rs2.Fields("District") & ", " & "RO #: " & rs2.Fields("RO #") & vbNewLine & "Detailed Update:" & vbNewLine & "Estimated Completion Time:" & vbNewLine & vbNewLine
                xSPName = rs2.Fields("Service Provider Name") & "," & vbNewLine & vbNewLine
                xIntro =  "Please reply with a ""Detailed Update"" and ""Estimated Completion Time"" for each unit." & vbNewLine & vbNewLine
                xSignature = "Thank you," & vbNewLine & vbNewLine & "Company Name"
                xArea = rs2.Fields("Area")
                
                .MoveNext
            Loop
            .Close
        End With
        Set outMail = outApp.CreateItem(olMailItem)
        outMail.SentOnBehalfOfName = xArea & "Test@Testing.com"
        outMail.To = "<" & emailTo & ">"
        outMail.Subject = emailSubject
        outMail.body = xSPName & xIntro & emailText & xSignature
        outMail.send
        Set outMail = Nothing
        rs1.MoveNext
    Loop
    
    rs1.Close
    Set rs1 = Nothing
    Set db = Nothing

    If outlookStarted Then
        outApp.Quit
    End If
    
    Set outMail = Nothing
    Set outApp = Nothing
Go to the top of the page
 
cheekybuddha
post May 8 2019, 01:23 PM
Post#17


UtterAccess VIP
Posts: 11,187
Joined: 6-December 03
From: Telegraph Hill


>> xSignature = "Thank you," & vbNewLine & vbNewLine & "Company Name" <<

I guess Company Name is replaced with your actual company name.

This line night effectively be moved outside the loop since it doesn't depend on any fields of rs2 - no need to keep setting it repeatedly!

Glad, you've got it working!

thumbup.gif

d

--------------------


Regards,

David Marten
Go to the top of the page
 
NICKRICKARDS
post May 18 2019, 08:50 AM
Post#18



Posts: 7
Joined: 10-May 19



Hi all,

so will this code also work with access 2013, as i have some users on 2016 and some on the older version?
Go to the top of the page
 
MadPiet
post May 21 2019, 04:58 PM
Post#19



Posts: 3,057
Joined: 27-February 09



Should work fine. I can't remember, but I think the filetype for 2013 and 2016 is almost exactly the same.
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    24th May 2019 - 01:59 AM