ABC ~ All 'Bout Computers
The Online Web-azine for Computer Enthusiasts
-- brought to you by

contents page for this issue

James's Database
~~James La Borde

Creating an Automated Report Database

Hello everyone. As promised in my last article which discussed Creating pdf Files from Access Reports, I will be posting the coding I use to run a list of reports on a regular basis. This will be a somewhat advanced topic for some of you but I have tried to document the code as well as I could for you as I went along. Please bear in mind that this is by no means the only way to accomplish this, but it is one way. 

First, you will want to create a table to list your reports and the like. Here is the structure of my table: 

This will give you the basics to run a schedule of reports. It is vital that the report names be exact. I have created a combo-box listing all the reports in my table for mine so that I know they are exact. I also have a table of frequencies to link to the WhentoRun Field. This table is set up as follows: 

In the above table it is very important to follow the numbering scheme rather than rely on Autonumber. These numbers are very important. When you set up your form to input the reports make sure to link the number, not the name of the field.

One more table to set up and you are ready to go. This one is an Archive Format table. I have more data in mine than you will probably need but here are the basics: 

The above table does need a little more explanation. The first field lists where you would like the reports to be put. It can be a local drive or a network drive or any folder on any of those drives. The Archive Format needs to be specific. The best way to get this is to open a macro and look at the format options there. Select the one you want and copy and past the format here. (Note this can be turned into a combo-box but ensure that the data stored is the actual name and a number referring to it.) I have added PDF for my system as I have Adobe Acrobat installed. If you do as well, you can include this option. The Archive extension is the extension of your selected archive. If you have created a combo-box with the format, you can auto-populate this field. The DateCheck field is a yes/no field that I include as I include date verification as part of my procedure and sometimes want to turn it off for various reasons. The most important thing to remember about this table is that there should only be one row. If changes are necessary, change them in that same row. 

Once you have populated your tables, you are ready to go.

The following code will loop through your first table and produce your reports based on your input into the last table.

Here is the code (I have tried to comment it in Green so that you can follow along):

Option Compare Database

Option Explicit

'   Declare a Public Variable to handle 2501 Errors

Public str2501 As String

Function RunfromList()

On Error GoTo RunfromList_Err

'   Define a temporary recordset to hold the Database Information

Dim db As DAO.Database

Dim rsTemp1 As DAO.Recordset

Dim rec2Temp As DAO.Recordset

Set db = CurrentDb()

‘  This field is optional. This is where I get my date to check.

Set rsTemp1 = db.OpenRecordset("dbo_zzSystem_")

'   Set Recordset to ArchiveTable

Set rec2Temp = db.OpenRecordset("ArchiveInfo")

rec2Temp.MoveFirst   '   Sets the current record to the first (and only) record.

'   Check to see if the Database has been updated to lastnight's EOD only if the Date Checking is

'  turned on. This is the optional date checking that I mentioned. You will want to set your date

'  checking up to your own specifications.

If rec2Temp!DateCheck = -1 Then

    If rsTemp1!DatabaseDate <> Date - 1 Then

        DoCmd.OpenReport "DBNotUpdated", acNormal, "", ""

        GoTo RunfromList_Exit

    End If

End If

'   Reset System Date Check recordset to nothing to save resources

Set rsTemp1 = Nothing 

'   Define all variables

Dim rec As DAO.Recordset

Dim StrCurMacro As String                   '  This will also let you run macros

Dim StrCurReport As String

Dim strCurMonthTxt As String

Dim StrLMonthTxt As String

Dim strDate4 As String

Dim StrDate As Date

Dim strDoW As String

Dim strDoM As String

Dim StrNQ As String

Dim StrMonthNum As String

Dim StrDayNum As String

Dim StrMonth As String

Dim SBegin As String

Dim BlnEndofMonth As Boolean 

'   Define Archive Table Variables 

Dim strArcPath As String

Dim strArcFormat As String

Dim strArcExt As String

Dim strArchive As String

Dim strArcMonth As String

Dim strMySubj As String

Dim strBody As String

'   Set variables based on Archive Table.

    strArcPath = rec2Temp!ArchivePath

    strArcExt = rec2Temp!ArchiveExt

    strArcFormat = rec2Temp!ArchiveFormat

'   Determine the current date

StrDate = Date

'   Set all variable based on Date

strDoW = DatePart("w", StrDate)

strDoM = DatePart("d", StrDate)

StrLMonthTxt = Format(DateAdd("m", -1, Date), "mmmm")

strCurMonthTxt = Format(Date, "mmmm")

StrMonth = DatePart("m", StrDate)

StrMonthNum = IIF(DatePart("m", StrDate - 1) < 10, 0 & DatePart("m", StrDate - 1), DatePart("m", StrDate - 1))

StrDayNum = IIF(DatePart("d", StrDate - 1) < 10, 0 & DatePart("d", StrDate - 1), DatePart("d", StrDate - 1))

strDate4 = StrMonthNum & StrDayNum

StrNQ = IIF(DatePart("m", StrDate) = 1 Or DatePart("m", StrDate) = 4 Or DatePart("m", StrDate) = 7 Or DatePart("m", StrDate) = 10, "Yes", "No")

BlnEndofMonth = IIF(DatePart("m", Date) <> DatePart("m", Date + 1), True, False)

'   Ensure that the Archive Path is in the proper format

If Right(strArcPath, 1) <> "\" Then

    strArcPath = strArcPath & "\"

End If

'   Check to ensure that the appropriate directory exists, if not, create it.

strArcMonth = strArcPath & strCurMonthTxt & "\"

If Dir(strArcMonth & "*.*") = "" Then

    MkDir strArcMonth

    DoCmd.OutputTo acReport, "Report1", "MS-DOSText(*.txt)", strArcMonth & "justfillingSpace.txt", False, ""

End If

'   Activate the table

Set rec = db.OpenRecordset("ScheduleTable")

'   Select first record and evaluate it based on current date and its schedule, then loop through to repeat for each

' record. A check to see if an email request is included. All reports that are archived are archived to the designated

' folder in a monthly directory.

rec.MoveFirst   '   Sets the current record to the first record.

'   Turns off the Warnings

DoCmd.SetWarnings False

'  This is where the working code really gets started

With rec

Do

SBegin = Timer  '  This turns the timer on to keep track of how long it takes to run the report

'  Set Row level variables

StrCurMacro = rec!ObjectToRun

StrCurReport = rec!ObjectToRun

strArchive = strArcPath & strCurMonthTxt & "\" & StrCurReport & strDate4 & strArcExt

strMySubj = "Your " & StrCurReport & " Report"

strBody = "Your Report,  " & StrCurReport & " can be found at: <html><a href='" & strArcPath & _ strCurMonthTxt & "\" & StrCurReport & strDate4 & strArcExt & "'>Here</a></html>"

' By adding the Lastrun variable and making it have a default date in the form, the database is restartable and can

' pick up where it left off. This code evaluates the frequency setting mathematically to see if the report should

' run

If (rec!whentorun = 1 And rec!LastRun <> Date) Or (rec!whentorun - 1 = strDoW And rec!whentorun >= _ 2 And rec!whentorun <= 8 And rec!LastRun <> Date) Or (rec!whentorun - 8 = strDoM And rec!LastRun _ <> Date) Or (rec!whentorun = 40 And strDoM = "1" And StrNQ = "Yes" And rec!LastRun <> Date) Or  _

(rec!whentorun = 42 And strDoM = "1" And StrMonth = "1" And rec!LastRun <> Date) Or  _

(rec!whentorun = 43 And BlnEndofMonth = True) Then

                        Select Case rec!ObjectType

                                       Case "Report"

                            If rec!Archive = -1 Then

                                                If strArcExt = ".pdf" Then

                        ' This should call the code to Reset the Default Printer to the PDF Writer, then

                        ' Set the report name so it will be produced without human intervention.

                        ' The code then resets the default printer to its original setting.

                                    Call ChangeToAcrobat

                                    Call ReporttoPDF(strArchive, StrCurReport)

                            ' Print Report with Current Report Name indicating that there is no data available for report.

                                If str2501 = "Yes" Then

                                    Call ChangeToAcrobat

                                    Call ReporttoPDF(strArchive, "rpt2501")

                                    str2501 = "No"

                               End If

                                     Else

                            DoCmd.OutputTo acOutputReport, StrCurReport, strArcFormat, strArchive, False, ""

                        End If

                    End If

                    If rec!Print = -1 Then

                        DoCmd.OpenReport StrCurReport, acNormal, "", ""

                    End If

            '  Please note that the email rep part of this code is not included. I will be publishing this at a later date.

                    If rec!EmailRep = -1 Then

                        Call SendMessage(rec!EmailAdd, strMySubj, strBody, "")

                    End If

            '  This will update the lastrun date and the timer settings

                    rec.Edit

                    rec!LastRun = StrDate

                    rec.Update

                    rec.Edit

                    rec!LengthLR = Timer - SBegin

                    rec.Update

            ‘  This checks for the end of file tag.

                        If rec.EOF = True Then

                        rec.Close

                        End If

            Case "Macro"

                DoCmd.RunMacro StrCurMacro, , ""

                rec.Edit

                rec!LastRun = StrDate

                rec.Update

                rec.Edit

                rec!LengthLR = Timer - SBegin

                rec.Update

                    If rec.EOF = True Then

                    rec.Close

                    End If

        End Select

    End If

End If

SkipIt:  '  Label to skip to for 2501 error  (No Data for Report)

rec.MoveNext

Err.Clear

Loop Until rec.EOF    ' This should go through each record to evaluate until it gets through the end of the table

End With

' This prints a report of the scheduled tasks (assuming you create the report)  This way you can verify that it ran.

DoCmd.OpenReport "rptScheduleTable", acNormal, "", ""

GoTo RunfromList_Exit

RunfromList_Err:

' Skip any error caused by a cancel on no data

    If Err.Number = 2501 Then

        rec.Edit

        rec!LastRun = StrDate

        rec.Update

        rec.Edit

        rec!LengthLR = Timer - SBegin

        rec.Update

        Resume SkipIt

    Else

        MsgBox Error$

        Resume Next

    End If

RunfromList_Exit:

Set db = Nothing

Set rec = Nothing

Set rec2Temp = Nothing

End Function 

How is this automated you may ask? Well there are a couple of ways to automate this. First, you can tie the code to a button and allow it to run on command. My preference is to create a simple batch file to call this database and then create an autoexec macro to runcode for this code. An autoexec macro will execute upon opening the database. Simply schedule the batch file to be called from the Win98/ Win 2K scheduler and you are ready to go. Since the Lastrun field is included and updated on a regular basis, any reports that do not complete for any reason, can be re-run simply by restarting the application. The LengthLR field is sometimes interesting, but can be a very useful tool in troubleshooting.  

As promised in the comments, next month’s issue will have the email application portion of this code. I welcome any comments or suggestions and would love to hear from you on anything you would like to see in this space.

NOTE FROM LINDA:  Those of you who are new to Access or VBA coding, might want to join my Microsoft Office email group where James and many other members are happy to help newbies learn this stuff.  To join this group, just go here and enter your email address and hit the Subscribe button.
http://www.freelists.org/webpage/mso

<<<back to contents

James La Borde works in the computer department at a Credit Union, where he uses Access, SQL Server, VBA, and ODBC daily.  He also teaches online Access classes at Eclectic Academy.