Automated Report Export

Leesha
BronzeLounger
Posts: 1484
Joined: 05 Feb 2010, 22:25

Re: Automated Report Export

Post by Leesha »

OK that is what I thought but wanted to be sure. And it would go on the OnTimer event?

User avatar
HansV
Administrator
Posts: 78350
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Automated Report Export

Post by HansV »

Yes, or in the On Load event of the startup form.
Best wishes,
Hans

Leesha
BronzeLounger
Posts: 1484
Joined: 05 Feb 2010, 22:25

Re: Automated Report Export

Post by Leesha »

Great! Thanks again!

Leesha
BronzeLounger
Posts: 1484
Joined: 05 Feb 2010, 22:25

Re: Automated Report Export

Post by Leesha »

Hi Hans,
This new code worked like a charm and the end users are thrilled, to say the least. Of course now they need a different version. They have email notices that go out at varying intervals, to notify when the next contract is due. The only thing I can come up with is a dlookup query that would run everyday (I would use the original code you gave me). If the query is null, nothing would happen. If the query contains email addresses, it would sned an auto-email to each person in the query with an attachment. I haven't tried this yet and wanted to see if you had any other ideas that might work better.
Thanks!
Leesha

User avatar
HansV
Administrator
Posts: 78350
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Automated Report Export

Post by HansV »

If you provide more detailed information, I might be able to recommend something.
Best wishes,
Hans

Leesha
BronzeLounger
Posts: 1484
Joined: 05 Feb 2010, 22:25

Re: Automated Report Export

Post by Leesha »

OK, here goes:

1. Emails will contain an attachment about the renewal of their contract. This is saved in a folder on the Server, address is still being determined.
2. Emails are sent out based on the [Contract Expiration].
3. The information below is stored in tblContractExpirationDate.
4. The time frames for the email are as follows:
a. 240 days prior to [Contract Expiration]
b. 220 days prior to [Contract Expiration]
c. 200 days prior to [Contract Expiration]
d. 181 days prior to [Contract Expiration]
e. 180 days prior to [Contract Expiration]
5. The dates listed below are calculated each day by the current date. If the [Contract Expiration] meets any of the deadlines listed above the email is sent. So Today is 11/16/22. [Contract Expiration] - Now() would determine if a letter goes out. The email will only go out once per day.
6. If [AcceptContractRenewalDate] or [DeclineContractRenewalDate] are not null, the letter doesn't go out. A date in either of these two fields indicated that the owner has responded and therefore shouldn't get future letters.
7. The email recipient names are stored in tblContractEmail. The recipients are defined as:
a. OwnerEmail
b. CC1
c. CC2
d. CC3
I think that is it.
Thanks!
Leesha

User avatar
HansV
Administrator
Posts: 78350
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Automated Report Export

Post by HansV »

Could you attach a zipped sample database?
Best wishes,
Hans

Leesha
BronzeLounger
Posts: 1484
Joined: 05 Feb 2010, 22:25

Re: Automated Report Export

Post by Leesha »

Here you go. I had to create it as it's just been in theory so far. There is not code on form Switchboard.
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 78350
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Automated Report Export

Post by HansV »

Thanks I'll work on it, but it'll take a while.
Best wishes,
Hans

Leesha
BronzeLounger
Posts: 1484
Joined: 05 Feb 2010, 22:25

Re: Automated Report Export

Post by Leesha »

NP! I'm glad I asked if you had any ideas before I attempted it. I can't wait to see what you come up with. It's always such a great learning experience.
Thanks!
Leesha

User avatar
HansV
Administrator
Posts: 78350
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Automated Report Export

Post by HansV »

See the attached version. Please test thoroughly!

ExpirationDateSample.zip
You do not have the required permissions to view the files attached to this post.
Best wishes,
Hans

Leesha
BronzeLounger
Posts: 1484
Joined: 05 Feb 2010, 22:25

Re: Automated Report Export

Post by Leesha »

Thanks! I can't wait to see what the code looks like and the rationale behind it.
So excited to earn more,
Alicia

User avatar
HansV
Administrator
Posts: 78350
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Automated Report Export

Post by HansV »

Leesha wrote:
17 Nov 2022, 13:06
So excited to earn more,
Aren't we all! :evilgrin:
Best wishes,
Hans

Leesha
BronzeLounger
Posts: 1484
Joined: 05 Feb 2010, 22:25

Re: Automated Report Export

Post by Leesha »

I downloaded the file but it gives me an error on opening that a potentially dangerous macro is being blocked. As a result only the tables and forms show. I tried holding down the shift key but that didn't work. I also clicked the unblock button under Properties. This gave me the enable option on opening the DB but still nothing shows but the form/tables. Suggestions?
Thanks!
Alicia

User avatar
HansV
Administrator
Posts: 78350
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Automated Report Export

Post by HansV »

Open your own version, then create an On Load event procedure for the Switchboard form:

Code: Select all

Private Sub Form_Load()
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim fld As DAO.Field
    Dim sql As String
    Dim days As Variant
    Dim dtm As Date
    Dim adr As String
    Dim outApp As Object
    Dim outMsg As Object

    On Error Resume Next
    ' Try to get running instance of Outlook
    Set outApp = GetObject(Class:="Outlook.Application")
    If outApp Is Nothing Then
        ' If Outlook wasn't running, start it
        Set outApp = CreateObject(Class:="Outlook.Application")
        If outApp Is Nothing Then
            ' We failed to start Outlook, so get out
            MsgBox "We can't start Outlook, sorry!", vbCritical
            Exit Sub
        End If
    End If
    On Error GoTo ErrHandler

    Set dbs = CurrentDb
    ' Select only records for which the contract hasn't been declined or accepted yet
    sql = "SELECT * FROM tblContractExpirationDate WHERE DeclineContractRenewalDate Is Null AND AcceptContractRenewalDate Is Null"
    Set rst = dbs.OpenRecordset(sql, dbOpenDynaset)
    Do While Not rst.EOF
        ' Get the expiration date
        dtm = rst("Contract Expiration")
        ' Get the owner email address
        adr = DLookup("OwnerEmail", "tblOwnerInformation", "Store_ID=" & Int(rst("Store_ID")))
        ' Loop through the reminder days
        For Each days In Array(240, 220, 200, 181, 180)
            Set fld = rst(days & "DateSent")
            ' Check if the renewal date is n or fewer days ahead and the n day mail hasn't been sent yet
            If dtm <= Date + days And IsNull(fld) Then
                ' Create message
                Set outMsg = outApp.CreateItem(0)
                With outMsg
                    ' Add recipient
                    .Recipients.Add adr
                    ' Change the subject as needed
                    .Subject = "Contract Renewal Reminder"
                    ' Change the body text as needed
                    .Body = "Your contract is due to expire on " & Format(dtm, "dddd m/d/yyyy")
                    ' Use ONE of the two following lines, not both
                    .Display ' to view/edit the message before sending
                    '.Send    ' to send the message without intervention
                End With
                ' Set the mail date
                rst.Edit
                fld = Date
                rst.Update
                ' Don't process further reminders for this contract
                Exit For
            End If
        Next days
        rst.MoveNext
    Loop

ExitHandler:
    On Error Resume Next
    rst.Close
    Set rst = Nothing
    Set dbs = Nothing
    Set outMsg = Nothing
    Set outApp = Nothing
    Exit Sub

ErrHandler:
    If Err = 2501 Then
        Resume Next
    Else
        MsgBox Err.Description, vbExclamation
        Resume ExitHandler
    End If
End Sub
Best wishes,
Hans

Leesha
BronzeLounger
Posts: 1484
Joined: 05 Feb 2010, 22:25

Re: Automated Report Export

Post by Leesha »

Ok will do! I'm sure I'll be back with questions as I try to understand the code. :-)

Leesha
BronzeLounger
Posts: 1484
Joined: 05 Feb 2010, 22:25

Re: Automated Report Export

Post by Leesha »

Hi Hans,
I actually understood what the code is doing! I have a few questions.
1. adr speaks to the Owner Email. Where in the code does it add the 3 CC emails from tblEmailRecipients?
2. I will need to add an attachment which is the letter with the specifics re the contract renewal. I'm assuming I add the code for the attachment after the Body section? I wanted to check first to be sure I don't blow it up.
3. I will need to update tblContractExpirationDate with the date the email was sent. There are separate cells for each date field. Normally I do this with an update query after the code runs, before it loops. I'm not sure how to do this using Arrays (which is a first for me) so that the correct box is updated with the date. The reason the user needs the date for each time frame sent is for legalities.
Thanks,
Leesha

User avatar
HansV
Administrator
Posts: 78350
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Automated Report Export

Post by HansV »

1) It doesn't, yet. I'll add that later (or you can do it yourself)
2) We can add an attachment anywhere between the lines

With OutMsg

and

.Display

3) The code already updates the relevant date field in this section of the code:

Code: Select all

                ' Set the mail date
                rst.Edit
                fld = Date
                rst.Update
Best wishes,
Hans

Leesha
BronzeLounger
Posts: 1484
Joined: 05 Feb 2010, 22:25

Re: Automated Report Export

Post by Leesha »

1) - you are too funny re me doing it myself. I will admit I did just look at previous code you've given me with other email situations but I'm pretty confident I'll blow it up!
2) I did test with an attachment and it worked!
3) That is awesome! I didn't realize that is what the code was doing.

Here is what I found on testing:
a. The email is not sent if there is a date in either [AcceptContractRenewalDate] or [DeclineContractRenewalDate] which is perfect!
b. Every owner received a 240 day email regardless of whether it was due or not and only the 240 day cell had a date put in it. The way it should be is each day the code would look for stores with an [Contract Expiration] in the future based on the days out. IE:
Emails being sent based on today's date would only send emails where the [contract expiration] date is the same as below.
7/15/2023 240DateSent
6/26/2023 220DateSent
5/17/2023 181DateSent
5/16/2023 180DateSent
If a date does not = one of the dates above than no email is sent on that day. Also, the corresponding date cell is updated with today's date. IE the contract with 7/15/2023 [contract expiration] would be updated in the [240DateSent] cell, 6/26/2023 would be updated in the [220DateSent] and so on.

I will understand if I just made it impossible to do this. BTW just saw your response to my comment of "So excited to earn more". Laughed right out loud! Talk about Freudian. Oh well, gotta pay these kid's college education somehow! :-)

User avatar
HansV
Administrator
Posts: 78350
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Automated Report Export

Post by HansV »

The idea was that if the code isn't run on the exact date, it will be run the next time. Since the 240DateSent field was empty in all records, the code generated an email for all of them.
In the version below. the mail is only generated on the exact date. So if the code is not run on the day 240 days before the expiration date, the 240 days reminder will not be sent.
I have added code for the CC's.

Code: Select all

Private Sub Form_Load()
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim rstCC As DAO.Recordset
    Dim fld As DAO.Field
    Dim sql As String
    Dim days As Variant
    Dim dtm As Date
    Dim adr As String
    Dim outApp As Object
    Dim outMsg As Object

    On Error Resume Next
    ' Try to get running instance of Outlook
    Set outApp = GetObject(Class:="Outlook.Application")
    If outApp Is Nothing Then
        ' If Outlook wasn't running, start it
        Set outApp = CreateObject(Class:="Outlook.Application")
        If outApp Is Nothing Then
            ' We failed to start Outlook, so get out
            MsgBox "We can't start Outlook, sorry!", vbCritical
            Exit Sub
        End If
    End If
    On Error GoTo ErrHandler

    Set dbs = CurrentDb
    ' Select only records for which the contract hasn't been declined or accepted yet
    sql = "SELECT * FROM tblContractExpirationDate WHERE DeclineContractRenewalDate Is Null AND AcceptContractRenewalDate Is Null"
    Set rst = dbs.OpenRecordset(sql, dbOpenDynaset)
    Set rstCC = dbs.OpenRecordset("tblEmailRecipients", dbOpenDynaset)
    Do While Not rst.EOF
        ' Get the expiration date
        dtm = rst("Contract Expiration")
        ' Get the owner email address
        adr = DLookup("OwnerEmail", "tblOwnerInformation", "Store_ID=" & Int(rst("Store_ID")))
        ' Loop through the reminder days
        For Each days In Array(240, 220, 200, 181, 180)
            Set fld = rst(days & "DateSent")
            ' Check if the renewal date is n or fewer days ahead and the n day mail hasn't been sent yet
            If dtm = Date + days And IsNull(fld) Then
                ' Create message
                Set outMsg = outApp.CreateItem(0)
                With outMsg
                    ' Add recipient
                    .Recipients.Add adr
                    ' Add CC
                    rstCC.MoveFirst
                    Do While Not rstCC.EOF
                        .Recipients.Add(rstCC("Recipient")).Type = 2
                        rstCC.MoveNext
                    Loop
                    ' Change the subject as needed
                    .Subject = "Contract Renewal Reminder"
                    ' Change the body text as needed
                    .Body = "Your contract is due to expire on " & Format(dtm, "dddd m/d/yyyy")
                    ' Use ONE of the two following lines, not both
                    .Display ' to view/edit the message before sending
                    '.Send    ' to send the message without intervention
                End With
                ' Set the mail date
                rst.Edit
                fld = Date
                rst.Update
                ' Don't process further reminders for this contract
                Exit For
            End If
        Next days
        rst.MoveNext
    Loop

ExitHandler:
    On Error Resume Next
    rst.Close
    Set rst = Nothing
    rstCC.Close
    Set rstCC = Nothing
    Set dbs = Nothing
    Set outMsg = Nothing
    Set outApp = Nothing
    Exit Sub

ErrHandler:
    If Err = 2501 Then
        Resume Next
    Else
        MsgBox Err.Description, vbExclamation
        Resume ExitHandler
    End If
End Sub
Best wishes,
Hans