Email generation & tracking system - loops querydefs recordsets...

[DonnaCulff]

Good afternoon,

I have a previous post linking to this one but the way i am now doing it is different (Hence this new post)

My aim is to import data, use a query to pull back the previous weeks data. Generate an email with this data. Then, the next week, import that data and send that. Keeping a record as you go along.

This is the code i have to date with a decription of what it currently does and what i actually am working towards:

Private Sub cmdExitandUpdate_Click()
Dim rst As Recordset
Dim rstForms As Recordset
Dim nIndex As Integer
On Error GoTo Err_Duplicate
Set rst = CurrentDb.OpenRecordset("tblWorkRequests")
Set rstForms = Forms("[frmCompletedWorkRequestsFROMteamsite]").RecordsetClone
rstForms.MoveFirst
Do While Not rstForms.EOF
   ' If rst.EOF Then
        rst.AddNew
        rst!WorkRequestID = rstForms!ID
        rst!AnalystName = rstForms!Assigned_To
        rst!DateOfRequest = rstForms!Start_Date
        rst!Requestor = rstForms!Work_Request_Created_by
        rst!WorkRequestTitle = rstForms!Title
        rst!WorkRequestDescription = rstForms!Description
        rst!RequestCompletionDate = rstForms!Due_Date
        rst!UserID = DADCurrentUser.UserID
        rst!SentDate = Now()
        rst!Sent = True
        rst.Update
        rstForms.MoveNext
    'Else
     '   rst.Edit
     '   rst!WorkRequestID = rstForms!ID
     '   rst!AnalystName = rstForms!Assigned_To
     '   rst!DateOfRequest = rstForms!Start_Date
     '   rst!Requestor = rstForms!Work_Request_Created_by
     '   rst!WorkRequestTitle = rstForms!Title
     '   rst!WorkRequestDescription = rstForms!Description
     '   rst!RequestCompletionDate = rstForms!Due_Date
     '   rst!UserID = DADCurrentUser.UserID
     '   rst!SentDate = Now()
     '   rst!Sent = True
     '   rst.Update
    'rstForms.MoveNext
    'End If
Loop
Call DAO_Execute
rst.Close
rstForms.Close
Set rst = Nothing
Set rstForms = Nothing
    DoCmd.Close acForm, Me.Name
Exit_Err_Duplicate:
    Exit Sub
Err_Duplicate:
    MsgBox Err.Description
    Resume Exit_Err_Duplicate
End Sub

I would like the email to be actually sent before tblWorkRequests is updated but I think that is just a matter of calling the below code a little earlier.

This bit creates an email based on the date searched for.
In an ideal world i am looking for there to be two parameters they can enter on the modified date so they can send a whole weeks...

Public Sub DAO_Execute()
'Database Query and Recordset Decs
Dim db As Database
Dim qdef As QueryDef
Dim rsContacts As DAO.Recordset
Dim fld As String
'Declaire Outlook and message variables/recordsets
Dim objOutlook As New Outlook.Application
Dim objEmail As Outlook.MailItem
Dim strLtrContent As String
Dim strEMailMsg As String
Dim ctlEmailBox As String
'Assigning values
ctlEmailBox = Nz(tLookup("SettingValue", "tblGlobalSettings", "SettingName = 'SpecialLetter'"), "Special Letter text not entered")
'rsContacts.ActiveConnection = CurrentProject.Connection *taken out as already done below
fld = "Assigned_To"
'Setting values
Set db = CurrentDb
Set qdef = db.QueryDefs("qryCompletedWorkRequests")
qdef.Parameters![Please enter a start date DD/MM/YYYY] = [Forms]!frmCompletedWorkRequestsFROMteamsite![Modified]
'qdef.Parameters![Please enter an end date DD/MM/YYYY] = [Forms]!frmCompletedWorkRequestsFROMteamsite![Modified]
Set rsContacts = qdef.OpenRecordset(dbOpenDynaset)
Do While Not rsContacts.EOF
        
        strLtrContent = "Dear " & rsContacts("Created_By") & "," & Chr(13) & Chr(13) & ctlEmailBox & Chr(13)
        strLtrContent = strLtrContent & "You will be rating how " & rsContacts("Assigned_To")
        strLtrContent = strLtrContent & " performed for the work request you submitted on " & rsContacts("Created") & "." & Chr(13)
        strLtrContent = strLtrContent & "Named: '" & rsContacts("Title") & "'" & Chr(13)
        strLtrContent = strLtrContent & "Please click on the link below and enter your work request ID (" & rsContacts("ID") & ") to begin. Complete all answers and press the 'Finish' button to complete." & Chr(13)
        strLtrContent = strLtrContent & "Thank you for your time." & Chr(13)
        strLtrContent = strLtrContent & "[URL]https://teams.cokecce.com/sites/SystemsInformationBSC/Lists/Customer%20Satisfaction%20Survey/NewForm.aspx?Source=https%3A%2F%2Fteams%2Ecokecce%2Ecom%2Fsites%2FSystemsInformationBSC%2FLists%2FCustomer%2520Satisfaction%2520Survey%2Foverview%2Easpx[/URL]" & Chr(13) & Chr(13)
        strLtrContent = strLtrContent & "The content of this email is the confidential property of Coca-Cola Enterprises and should not be copied, modified, retransmitted, or used for any purpose except with written authorization.  If you are not the intended recipient, please delete all copies and notify us immediately. " & Chr(13) & Chr(13) & _
        "Coca-Cola Enterprises Limited - Registered in England: Company Number 27173 - Registered Office: Charter Place,  Vine Street, Uxbridge UB8 1EZ" & Chr(13)
        Set objEmail = objOutlook.CreateItem(olMailItem)
        objEmail.Recipients.Add rsContacts("Created_By")
        objEmail.Subject = "Customer Satisfaction Survey BSC"
        objEmail.Body = strLtrContent
        objEmail.Importance = olImportanceHigh
        objEmail.BodyFormat = olFormatHTML
        objEmail.Display
        'objEmail.Send
        Debug.Print rsContacts!Assigned_To
        rsContacts.MoveNext
Loop
qdef.Close
rsContacts.Close
db.Close
End Sub

Can anyone point me in the right direction or even suggest a way i cna combine the two pieces of code?

 

[DonnaCulff]

Currently I am looking at using a field added to a query to mark (with a minus 1) the previous weeks completed work requests

Prev Week Completed: Year([ModDate])*53+DatePart("ww",[ModDate])=Year(Date())*53+DatePart("ww",Date())-1

Then I am looking at working this in somewhere to loop round the results and generate an email

So it would identify those with a completed date (Modified) of the 19th - 23rd.

If they rand this part was through a week. I want the code to be able to only generate emails for those not already sent, that is my next focus