Code Review from the experts, please

[DomFino]

I have, with the help of folks on this site and others, managed to create code that basically is a tickler file system that sends emails automatically when certain dates arrive.

Anyway, as I look at the code I am thinking there might be a better way to do this by using less code. For example, I have four sections of code for each of the four quarters. I was wondering if this could be shortened to one by using variables? As I said, with the help of folks on this site, I managed to accomplish this in the SQL statement that runs to select the records to process through email.

I know this is an odd request, but I am looking for any suggestions or comments as to how the code could be shortened or made more efficient. I believe in code reviews as they tend to make things much better for all involved. Plus, I get to learn from the experts.

Thanks in advance to anyone who decides to read the following code and comment.

Dom

Option Compare Database
Option Explicit
'TicklerDT - date - Date to send reminder
'TicklerReason - memo - Reason to check the record
'TicklerPerson - text - person to send reminder to
'TicklerSent - yes/no - checked when the code issues the reminder.
'Note - need to set a reference to DAO and to your version of Outlook before using the code

Private Sub Form_Load()
'call the routine to check for ticklers that are due
CheckForTicklers
End Sub

Private Sub CheckForTicklers()
'checks to see if the given user is due for a reminder about a particular grant
On Error GoTo ErrorHandler
'create a recordset of all unsent ticklers this user has set
Dim rstCurrent As Recordset
Dim strSQL As String
Dim strSQLtest As String
Dim strUserName As String
Dim db As Database
Dim curr_rec As String
'set tickler dates and report due dates for the current year
Dim yr As Long
yr = Year(Now())
Me.txtYear.Value = Year(Now())
Dim ReportDueDT1 As Date
Dim ReportDueDT2 As Date
Dim ReportDueDT3 As Date
Dim ReportDueDT4 As Date
Dim TicklerDT1 As Date
Dim TicklerDT2 As Date
Dim TicklerDT3 As Date
Dim TicklerDT4 As Date
ReportDueDT1 = "1/15/" & Me.txtYear.Value
ReportDueDT2 = "4/15/" & Me.txtYear.Value
ReportDueDT3 = "7/15/" & Me.txtYear.Value
ReportDueDT4 = "10/15/" & Me.txtYear.Value
TicklerDT1 = "1/1/" & Me.txtYear.Value
TicklerDT2 = "4/1/" & Me.txtYear.Value
TicklerDT3 = "7/1/" & Me.txtYear.Value
TicklerDT4 = "10/1/" & Me.txtYear.Value
Dim sUser As String
Dim sQuarter As Variant
'get the login user name
strUserName = Environ("USERNAME")
sUser = strUserName
' Sets the current record so that after DoCmd.Requery the same record appears
curr_rec = Me.CurrentRecord
Set db = CurrentDb
' Quarter 1 Processing 
If ReportDueDT1 >= DateAdd("d", -14, Now()) And GrantID = Me!GrantID Then
    strSQLtest = "SELECT Count(tblTickler.TicklerID) AS CountOfTicklerID " & _
    "From tblTickler WHERE (((tblTickler.ReportQuarter)=1) " & _
    "AND ((tblTickler.TicklerSent)=No));"
    If Count = 0 Then 'there are no records to process
        Exit Sub
    End If
    'otherwise there are records to process
    CurrentProject.Connection.Execute "UPDATE tblTickler SET " & _
    "tblTickler.ReportQuarter = 1, tblTickler.ReportDueDT = #" & ReportDueDT1 & "#, " & _
    "tblTickler.TicklerDueDT = #" & TicklerDT1 & "#;"
    sQuarter = 1
End If
'Quarter 2 Processing 
If ReportDueDT2 >= DateAdd("d", -14, Now()) And GrantID = Me!GrantID Then
    strSQLtest = "SELECT Count(tblTickler.TicklerID) AS CountOfTicklerID " & _
    "From tblTickler WHERE (((tblTickler.ReportQuarter)=2) " & _
    "AND ((tblTickler.TicklerSent)=No));"
    If Count = 0 Then 'there are no records to process
        Exit Sub
    End If
    'otherwise there are records to process
    CurrentProject.Connection.Execute "UPDATE tblTickler SET " & _
    "tblTickler.ReportQuarter = 2, tblTickler.ReportDueDT = #" & ReportDueDT2 & "#, " & _
    "tblTickler.TicklerDueDT = #" & TicklerDT2 & "#;"
    sQuarter = 2
End If
'Quarter 3 Processing 
If ReportDueDT3 >= DateAdd("d", -14, Now()) And GrantID = Me!GrantID Then
    strSQLtest = "SELECT Count(tblTickler.TicklerID) AS CountOfTicklerID " & _
    "From tblTickler WHERE (((tblTickler.ReportQuarter)=3) " & _
    "AND ((tblTickler.TicklerSent)=No));"
    If Count = 0 Then 'there are no records to process
        Exit Sub
    End If
    'otherwise there are records to process
    CurrentProject.Connection.Execute "UPDATE tblTickler SET " & _
    "tblTickler.ReportQuarter = 3, tblTickler.ReportDueDT = #" & ReportDueDT3 & "#, " & _
    "tblTickler.TicklerDueDT = #" & TicklerDT3 & "#;"
    sQuarter = 3
End If
' Quarter 4 Processing 
If ReportDueDT4 >= DateAdd("d", -14, Now()) And GrantID = Me!GrantID Then
    strSQLtest = "SELECT Count(tblTickler.TicklerID) AS CountOfTicklerID " & _
    "From tblTickler WHERE (((tblTickler.ReportQuarter)=4) " & _
    "AND ((tblTickler.TicklerSent)=No));"
    If Count = 0 Then 'there are no records to process
        Exit Sub
    End If
    'otherwise there are records to process
    CurrentProject.Connection.Execute "UPDATE tblTickler SET " & _
    "tblTickler.ReportQuarter = 4, tblTickler.ReportDueDT = #" & ReportDueDT4 & "#, " & _
    "tblTickler.TicklerDueDT = #" & TicklerDT4 & "#;"
    sQuarter = 4
End If
' Prepare dataset for email processing of records 
'Note: this SQL is run for each of the four quarters above _
with only the sQuarter field being replaced each time
strSQL = "SELECT tblTickler.TicklerID, tblTickler.GrantID, tblTickler.TicklerReason, " & _
"tblTickler.TicklerPerson, tblTickler.ReportDueDT, tblTickler.ReportQuarter, " & _
"tblTickler.TicklerDueDT, tblTickler.TicklerSent, tblGrantNameLKU.GrantName, " & _
"tblGrantIdentifierLKU.GrantIdentifier " & _
"FROM (tblGrantNameLKU INNER JOIN (tblGrantIdentifierLKU INNER JOIN tblGrants " & _
"ON tblGrantIdentifierLKU.GrantIdentifierID = tblGrants.GrantIdentifierID) " & _
"ON tblGrantNameLKU.GrantNameID = tblGrants.GrantNameID) INNER JOIN tblTickler " & _
"ON tblGrants.GrantID = tblTickler.GrantID " & _
"WHERE tblTickler.TicklerPerson='" & strUserName & "' AND " & _
"tblTickler.ReportQuarter= " & Replace(sQuarter, "'", "''") & " AND " & _
"tblTickler.TicklerSent=False"
Set rstCurrent = CurrentDb.OpenRecordset(strSQL)
If rstCurrent.RecordCount = 0 Then 'there are no ticklers pending
    'release the vaiable
    Set rstCurrent = Nothing
    Exit Sub
End If
' otherwise move to the last record to get an accurate record count
rstCurrent.MoveLast
rstCurrent.MoveFirst
Dim strSubject As String
Dim strBody As String
'loop through the recordset
Dim j As Integer
For j = 1 To rstCurrent.RecordCount
    strSubject = "Reminder on Grant - " & rstCurrent.Fields("GrantName") & "Grant Identifier - " & rstCurrent.Fields("GrantIdentifier")
    strBody = "You set a tickler to remind you about this Grant for the following reason: " & rstCurrent.Fields("TicklerReason")
    Call SendMessage(sUser, strSubject, strBody)
    'set the TicklerSent field to yes so this reminder will not be sent again
    rstCurrent.Edit
    rstCurrent.Fields("TicklerSent") = vbYes
    rstCurrent.Update
    rstCurrent.MoveNext
Next j
'release the variable
Set rstCurrent = Nothing
ErrorHandler:
MsgBox "Error #" & Err.Number & " occurred. " & Err.Description, vbOKOnly, "Error"
Exit Sub
End Sub

Private Sub SendMessage(Recipname As String, SubjectText As String, BodyText As String, Optional AttachmentPath As String)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
'Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
    'Add the To recipient(s) to the message.
    Set objOutlookRecip = .Recipients.Add("Zaranski, Bernard")
    objOutlookRecip.Type = olTo
    ' Add the CC recipient(s) to the message.
    Set objOutlookRecip = .Recipients.Add("Johnston, Kathleen;Fino, Dominic")
    objOutlookRecip.Type = olCC
    ' Set the Subject, Body, and Importance of the message.
    .Subject = SubjectText
    .Body = BodyText & vbCrLf
    .Importance = olImportanceHigh 'High importance
    ' Add attachments to the message.
    ' If Not IsMissing(AttachmentPath) And AttachmentPath <> vbNullString Then
        ' Set objOutlookAttach = .Attachments.Add(AttachmentPath)
    ' End If
    ' Resolve each Recipient's name.
    For Each objOutlookRecip In .Recipients
        objOutlookRecip.Resolve
        If Not objOutlookRecip.Resolve Then
            objOutlookMsg.Display
        End If
    Next
    'Show the email so it can be edited
    .Display
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub

[Jacob Hilderbrand]

You should be able to use a loop to replace the repeated code for the quarters like this:

For i = 1 To 4
    If ReportDueDT1 >= DateAdd("d", -14, Now()) And GrantID = Me!GrantID Then
        strSQLtest = "SELECT Count(tblTickler.TicklerID) AS CountOfTicklerID " & _
        "From tblTickler WHERE (((tblTickler.ReportQuarter)=" & i & ") " & _
        "AND ((tblTickler.TicklerSent)=No));"
        If Count = 0 Then 'there are no records to process
            Exit Sub
        End If
        'otherwise there are records to process
        CurrentProject.Connection.Execute "UPDATE tblTickler SET " & _
        "tblTickler.ReportQuarter = " & i & ", tblTickler.ReportDueDT = #" & ReportDueDT1 & "#, " & _
        "tblTickler.TicklerDueDT = #" & TicklerDT1 & "#;"
        sQuarter = I
    End If
Next i

[Daniel Klann]

Hi Dom,

The first thing I would say is that it would be useful if you can attach a zipped copy of your database. The reason for this is that most people won't bother trying to set up a sample in order to properly test your code. For example, in your code you refer to "GrantID" but I have no idea what that is. Anyway, here's my 3 cents:

1. You should be consistent in your naming convention of variables. For example you use strSQL, sUser and curr_rec to refer to string variables. You should choose a convention and stick to it (str is the preferred). Also, for dates use either dat or dte and for variants use v or vnt. Anyway, the most important thing is choosing one and using it consistently.
2. I'm not a fan of having declarations scattered throughout code. Put all of your declarations at the top of each procedure as this is where anyone looking at your code would expect to find them.

You may think these two points aren't going to make your application more efficient but that's not the case. Although neither of these two suggestions will result in improved execution time, they will make it much easier and quicker for someone making changes to your code in 6 weeks/months/years time, especially if that someone is not you. Anyway, I sound like I'm ranting so I'll move on...

You could combine the processing of each quarter into something like this:

'Quarter 1 to 4 Processing
Dim lngQuarter As Long
Dim dteReportDueDate As Date
Dim dteTicklerDate As Date
'Loop through each possible quarter for the year specified in txtYear
For lngQuarter = 1 To 4
    'This will results in dteReportDueDate being 1/15/yy, 4/15/yy, 7/15/yy or 10/15/yy
    'and dteTicklerDate being 1/1/yy, 4/1/yy, 7/1/yy or 10/1/yy
    dteReportDueDate = DateValue((lngQuarter * 3) - 2 & "/15/" & Me.txtYear.Value)
    dteTicklerDate = DateValue((lngQuarter * 3) - 2 & "/1/" & Me.txtYear.Value)
    If dteReportDueDate >= DateAdd("d", -14, Now()) And GrantID = Me!GrantID Then
        strSQLtest = "SELECT Count(tblTickler.TicklerID) AS CountOfTicklerID " & _
        "From tblTickler WHERE (((tblTickler.ReportQuarter)=" & lngQuarter & ") " & _
        "AND ((tblTickler.TicklerSent)=No));"
        If Count = 0 Then 'there are no records to process
            Exit Sub
        End If
        'otherwise there are records to process
        CurrentProject.Connection.Execute "UPDATE tblTickler SET " & _
        "tblTickler.ReportQuarter = " & lngQuarter & ", tblTickler.ReportDueDT = #" & dteReportDueDate & "#, " & _
        "tblTickler.TicklerDueDT = #" & dteTicklerDate & "#;"
        sQuarter = lngQuarter
    End If
Next lngQuarter

I haven't tested that but it looks like it does the same thing as your original code, but in less lines.

Next, your recordsets. Depending on which version of Access you're using there are 2 types of Recordset objects - DAO and ADO. When you declare a variable as recordset e.g. Dim rstCurrent As Recordset, the type of recordset will be determined by whichever library appears first in the references dialog. As a precaution and to ensure that the variable is declared exactly as you want I would do it explicitly e.g. Dim rstCurrent As DAO.Recordset. Also, you don't appear to be closing your recordsets, just setting them to nothing. In practice this shouldn't be a problem but you should close them explicitly in order that DAO can do whatever tasks it needs to do 'behind the scenes'. It also looks better and makes your code easier to follow e.g.

rstCurrent.Close
Set rstCurrent = Nothing

Finally (for now ), there is room for improvement in the way you're sending emails. Although the fact that you have the SendMessage routine separated from your main procedure is very good, it also presents a problem. If your recordset contains 100 records then that means your code is calling the SendMessage procedure 100 times. Each time you call that procedure you're creating a new instance of Outlook and then attempting to destroy it at the end which I'd imagine is a fairly time consuming activity. What I'd suggest is making your SendMessage procedure handle the entire task of creating the emails, by passing the recordset to the SendMessage procedure and looping through it there, rather than looping through it in the main procedure and jumping backwards and forwards. Something like this is what I mean. I haven't tested it but you should get the idea.

Private Sub SendMessages(daoRSRecipients As DAO.Recordset)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim strSubject As String
Dim strBody As String
'Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
'Loop through each recipients in the daoRSRecipients recordset and create an Outlook message
While Not daoRSRecipients.EOF
    strSubject = "Reminder on Grant - " & rstCurrent.Fields("GrantName") & "Grant Identifier - " & rstCurrent.Fields("GrantIdentifier")
    strBody = "You set a tickler to remind you about this Grant for the following reason: " & rstCurrent.Fields("TicklerReason")
    ' Create the message.
    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
    With objOutlookMsg
        'Add the To recipient(s) to the message.
        Set objOutlookRecip = .Recipients.Add("Zaranski, Bernard")
        objOutlookRecip.Type = olTo
        ' Add the CC recipient(s) to the message.
        Set objOutlookRecip = .Recipients.Add("Johnston, Kathleen;Fino, Dominic")
        objOutlookRecip.Type = olCC
        ' Set the Subject, Body, and Importance of the message.
        .Subject = SubjectText
        .Body = BodyText & vbCrLf
        .Importance = olImportanceHigh 'High importance
        ' Add attachments to the message.
       ' If Not IsMissing(AttachmentPath) And AttachmentPath <> vbNullString Then
            ' Set objOutlookAttach = .Attachments.Add(AttachmentPath)
        ' End If
        ' Resolve each Recipient's name.
        For Each objOutlookRecip In .Recipients
            objOutlookRecip.Resolve
            If Not objOutlookRecip.Resolve Then
                objOutlookMsg.Display
            End If
        Next
        'Show the email so it can be edited
        .Display
    End With
    Set objOutlookMsg = Nothing
    daoRSRecipients.Edit
    daoRSRecipients.Fields("TicklerSent") = vbYes
    daoRSRecipients.Update
    daoRSRecipients.MoveNext
Wend
objOutlook.Quit
Set objOutlook = Nothing
End Sub

Then you'd also need to change your CheckForTicklers procedure (I've just shown the relevant part of the code):

Set rstCurrent = CurrentDb.OpenRecordset(strSQL)
If rstCurrent.RecordCount = 0 Then 'there are no ticklers pending
    'release the vaiable
    rstCurrent.Close
    Set rstCurrent = Nothing
    Exit Sub
End If
Call SendMessages(rstCurrent)
'release the variable
rstCurrent.Close
Set rstCurrent = Nothing
ErrorHandler:
MsgBox "Error #" & Err.Number & " occurred. " & Err.Description, vbOKOnly, "Error"
Exit Sub

I think this is the longest reply I've ever posted to any forum so I REALLY hope it helps . Let me know how you get on with this lot.

Dan

[DomFino]

DRJ and Dan,

WOW! I really appreciate your taking the time to respond to my post. The information, suggestions, and downright clear common sense of your comets are overwhelming. I have read the replies several times and will need to digest them one at a time. However, I do understand what you guys are saying and will work on the changes one at a time so that I do not screw up too much at one time.



Today is Thanksgiving, and I jut added you two plus this entire site to the list of things I am Thankful for. Since I will be traveling to the family Feast, I will not be working on my database until this weekend. In the mean time, have a Happy and Safe Holiday and you will be hearing back from me soon. BTW, I wanted to attach a copy of my zipped database as suggested. However it is too large when zipped to meet the site requirements. I will work on stripping it down to fit over the next day or so.

Thank you very much for your very professional replies and expert knowledge.

Dom

[DomFino]

Well, I am through with the Turkey dinner and got back to work.



Dan, I applied all the changes (I think) that you suggested. It compiles okay but has a problem on line 121 ("tblTickler.ReportQuarter= " & Replace(vQuarter, "'", "''") & " AND " & _) For some odd reason the vQuarter variable is not making it to this section of code. I hard coded a number 4 in its place and it seems to work okay. I also tried putting single quotes around it but then received data type mismatch. Anyway, there is a syntax error and I have not figured out the problem. I also attached a stripped down version of the database as you suggested in the earlier post.



Thanks for your continued help,

Dom

[Daniel Klann]

Hi Dom,

You only need to surround the variables in quotes if you're working with text fields. For numbers you can just use something like this:

"WHERE tblTickler.TicklerPerson='" & strUser & "' AND " & _
            "tblTickler.ReportQuarter= " & vQuarter & " AND " & _
            "tblTickler.TicklerSent=False"

Does that work?

Dan

[DomFino]

Hi Dan,

I tried the code you suggested but no cigar. I receive the same error (see attached).


Frustrating when it is so close to working.
Dom

[DomFino]

Dan,

I think that I have this puppy figured out. I was receiving the error mentioned in the earlier post and thought the variable for the quarter (vQuarter) was not working. Well, I did some more testing and found the problem is with the If condition that counts records.

Originally, I had this code:

strSQLtest = "SELECT Count(tblTickler.TicklerID) AS CountOfTicklerID " & _
"From tblTickler WHERE (((tblTickler.ReportQuarter)='" & lngQuarter & ") " & _
"AND ((tblTickler.TicklerSent)= vbNo));"
If Count = 0 Then 'there are no records to process
    Exit Sub
End If

Well the value of Count is some number (27) not sure where it comes from but it was never ZERO so even if records did not pass the if test, the code would continue to execute below it since the EXIT SUB command was never triggered. With no records the variable vQuarter did not exist.

Anyway, I declaired a variable for the count as portion of the code. I then modified the if statement as follows:

strSQLtest = "SELECT Count(tblTickler.TicklerID) AS CountOfTicklerID " & _
"From tblTickler WHERE (((tblTickler.ReportQuarter)='" & lngQuarter & ") " & _
"AND ((tblTickler.TicklerSent)= vbNo));"
If CountOfTicklerID = 0 Then 'there are no records to process
    Exit Sub
End If

The new section of code looks like this. And it WORKS!

'Quarter 1 to 4 Processing
Dim lngQuarter As Long
Dim dteReportDueDate As Date
Dim dteTicklerDate As Date
Dim CountOfTicklerID As Integer
'Loop through each possible quarter for the year specified in txtYear
For lngQuarter = 1 To 4
    'This will results in dteReportDueDate being 1/15/yyyy, 4/15/yyyy, 7/15/yyyy or 10/15/yyyy
    'and dteTicklerDate being 1/1/yyyy, 4/1/yyyy, 7/1/yyyy or 10/1/yyyy
    dteReportDueDate = DateValue((lngQuarter * 3) - 2 & "/15/" & Me.txtYear.Value)
    dteTicklerDate = DateValue((lngQuarter * 3) - 2 & "/1/" & Me.txtYear.Value)
    If dteReportDueDate >= DateAdd("d", -14, Now()) And GrantID = Me!GrantID Then
        strSQLtest = "SELECT Count(tblTickler.TicklerID) AS CountOfTicklerID " & _
        "From tblTickler WHERE (((tblTickler.ReportQuarter)='" & lngQuarter & ") " & _
        "AND ((tblTickler.TicklerSent)= vbNo));"
        If CountOfTicklerID = 0 Then 'there are no records to process
            Exit Sub
       End If
       'otherwise there are records to process
       CurrentProject.Connection.Execute "UPDATE tblTickler SET " & _
       "tblTickler.ReportQuarter = " & lngQuarter & ", tblTickler.ReportDueDT = #" & dteReportDueDate & "#, " & _
       "tblTickler.TicklerDueDT = #" & dteTicklerDate & "#;"
       vQuarter = lngQuarter
   End If
Next lngQuarter
'Prepare dataset for email processing of records
'Note: this SQL is run for each of the four quarters above with only the vQuarter field being replaced each time
strSQL = "SELECT tblTickler.TicklerID, tblTickler.GrantID, tblTickler.TicklerReason, " & _
"tblTickler.TicklerPerson, tblTickler.ReportDueDT, tblTickler.ReportQuarter, " & _
"tblTickler.TicklerDueDT, tblTickler.TicklerSent, tblGrantNameLKU.GrantName, " & _
"tblGrantIdentifierLKU.GrantIdentifier " & _
"FROM (tblGrantNameLKU INNER JOIN (tblGrantIdentifierLKU INNER JOIN tblGrants " & _
"ON tblGrantIdentifierLKU.GrantIdentifierID = tblGrants.GrantIdentifierID) " & _
"ON tblGrantNameLKU.GrantNameID = tblGrants.GrantNameID) INNER JOIN tblTickler " & _
"ON tblGrants.GrantID = tblTickler.GrantID " & _
"WHERE tblTickler.TicklerPerson='" & strUser & "' AND " & _
"tblTickler.ReportQuarter= " & Replace(vQuarter, "'", "''") & " AND " & _
"tblTickler.TicklerSent=False"

Note: the code in red is from the original post and did not need to be changed since it was working all along.

Dan,
Thanks for your help on this one. Could not have done it without you.
Dom

[Daniel Klann]

Glad you got it sorted mate, and glad I could help.


Dan