Automated Report Export

[Leesha]

Hi Hans, back again. I'm attaching the stripped down version as I figured it would be easier for you. I tried adapting other code you've given me for attaching more than one report but they were for pdf's so I marked the code off so I could see if the emails are going out without error and of course they aren't. My ultimate goal is to attach the qryCDSLease and qryTTTSMLease so I can see the code in case I need to send more than 2 reports. For now I have the code on a command button to test it vs waiting for the timer to run.
Thanks!
Leesha

[HansV]

Could you attach the file? I think you forgot to do so...

[Leesha]

Sorry! I thought I did.

[HansV]

See the attached version.

HansAutosendEmail.zip

[Leesha]

Thanks! Here is what I'm getting:
1. The email opens to view to send. All of the recipients are listed.
2. There are no attachments in the report.
Leesha

[HansV]

That is because you commented out the code to add attachments...

[Leesha]

LOL, I commented it out because it's attaching pdf's and not queries. I wasn't sure how the code would look with queries. I'll give it a try.

[HansV]

You have to export the queries or reports or whatever to Excel workbooks, then attach the exported files to the email message.

[Leesha]

OK.........I think I'm up to the challenge. So I need to do the following?
1. The first part of the code will export and save the reports as excel files to a designated spot.
2 The email code will then look to that spot to pick up the reports as attachments.

[HansV]

Yes, that should work.

[Leesha]

This is the code that I used to export the queries. Where is the syntax do I designate the file folder and is there a way to replace the existing file without being prompted whether to replace it or not. The goal is to have this run on a computer without requiring user input.
Thanks!

DoCmd.OutputTo acQuery, "qryCDSLease", "MicrosoftExcelBiff8(*.xls)", "", False, "", 0
DoCmd.OutputTo acQuery, "qryTTTSMLease", "MicrosoftExcelBiff8(*.xls)", "", False, "", 0

[HansV]

It could look like this (this version exports to the more modern and much smaller file format .xlsx):

DoCmd.OutputTo acQuery, "qryCDSLease", acFormatXLSX, "C:\Temp\CDSLease.xlsx"
DoCmd.OutputTo acQuery, "qryTTTSMLease", acFormatXLSX, "C:\Temp\TTTSMLease.xlsx"

Change C:\Temp to the folder where you want to store the exported workbooks

[Leesha]

It worked perfectly!!! I even figured out how to put the attachments in! Thanks so much. This is awesome code and provides an option that I'll be to use elsewhere.

Thanks again for your patience and teaching,
Leesha

[HansV]

Signing off now - it's past midnight...

[Leesha]

Thanks for everything! Get a good night sleep!

[Leesha]

Hi Hans,
This process is working perfectly and the end user is thrilled with it. They have emails that go out on a specific date of the month. For example, there is a list that goes out on the 5th of every month. What would the code on the time section look like to set this up? Right now it's set to go out every day if the date in in the Dlookup query is prior to the current day. I played around with it but wasn't successful.
Thanks,
Leesha

[HansV]

I have added a constant at the beginning of the code. It specifies the day of the month to send the report.

Code: Select all

Private Sub Command1_Click()
    ' *** Day of the month to send ***
    Const Day2Send = 5
    ' ********************************
    Dim strSQL As String
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim sql As String
    Dim strFilename As String
    Dim outApp As Object
    Dim outMsg As Object
    Dim blnStart As Boolean
    Dim arrNames As Variant
    Dim i As Long
    Dim dtmLastSent As Date

'Sets up process to attach second report to email
    'Dim strInstructions As String
    'strInstructions = gstrPath & "Instructions.pdf"
    'DoCmd.OutputTo acOutputReport, "rptInsuranceInstructions", acFormatPDF, strInstructions

'Sets up process to attach third report to email
    'Dim strChecklist As String
    'strChecklist = gstrPath & "Checklist.pdf"
    'DoCmd.OutputTo acOutputReport, "rptInsuranceChecklist", acFormatPDF, strChecklist

    ' Check whether the report has been sent
    dtmLastSent = DLookup("DateSent", "qryDateLastSent")
    ' Only act if report was last sent before this month and if it's the day to send
    If Format(dtmLastSent, "yyyymm") < Format(Date, "yyyymm") And Day(Date) >= Day2Send Then
        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
            ' Set a flag that we started Outlook
            blnStart = True
        End If
        On Error GoTo ErrHandler

        ' Create message
        Set outMsg = outApp.CreateItem(0)
        With outMsg
            '.Attachments.Add strInstructions
            '.Attachments.Add strChecklist
            ' Assemble the recipients here
            Set dbs = CurrentDb
            ' SQL statement - modify as needed
            sql = "SELECT * FROM tblEmailRecipients ORDER BY RecipientName"

            Set dbs = CurrentDb
            Set rst = dbs.OpenRecordset(sql, dbOpenDynaset)
            Do While Not rst.EOF
                ' Add recipient
                .Recipients.Add rst!Recipient
                ' On to the next record
                rst.MoveNext
            Loop
            rst.Close
            ' Change the subject as needed
            .Subject = "Daily Reports"
            ' Change the body text as needed& vbCrLf & vbCrLf & Me.comment3
            .Body = "The requested report is attached."
            ' 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

        ' Update last sent date
        ' Suppress confirmation prompt
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "qryUpdateLastSent"
        DoCmd.SetWarnings True
    Else
        MsgBox "The report has already been sent"
    End If

ExitHandler:
    On Error Resume Next
    rst.Close
    Set rst = Nothing
    Set dbs = Nothing
    If blnStart Then
        outApp.Quit
    End If
    Set outMsg = Nothing
    Set outApp = Nothing
    DoCmd.SetWarnings True
    Exit Sub

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

[Leesha]

Thanks Hans! Can wait to try it.
Leesha

[Leesha]

Hi Hans,
I just want to be sure that I'm interpreting this correctly. The constraint that is in this code replaces the code below or do I still need the code below?
Thanks,
Leesha

If Hour(Now) >= 0 Then
' Check whether the report has been sent
dtmLastSent = DLookup("DateSent", "qryDateLastSent")
' Only act if report was last sent before today
If Int(dtmLastSent) < Date Then

[HansV]

The code that I posted replaces the entire procedure.