As the seasons change and years pass, trees accumulate rings that can be used to determine the age of the tree. This is a result of seasonal growth — the inner section of each ring is formed in the early part of the rapid growth season; this wood is called "early wood" (*snicker*). Then as the temperature changes and growth slows, the darker outer portion of the ring forms ("late wood"). And who can forget the classic scene from Vertigo in which Kim Novak's character hints at a passion for dendrochronology as she finds the years of her birth and death on the rings of a tree. Why do I bring this up? Because seeing bits of the past frozen in time is fascinating.

Nathan B. was called for help when an internal Access application was hanging. After some tinkering, he found that it wasn't hanging, as three reports had successfully printed and the fourth was on its way — it was just taking three times longer than it usually did. Sadly, the reports had to be done that day, and at this pace, they'd still be printing until 6:00 the next morning.

Nathan sighed and slumped into his chair. He was going to have to do something he really didn't want to do — open the file and look at the code. He'd heard horror stories about the original developer, but figured this was something he'd never have to deal with. By the time he found the below snippet, he felt like he needed a cold shower.

Function fDaysLeftInWeek(ByVal dateToTest As Date) As Integer   '*****new30
  ' Comments  : Returns
  ' Parameters:
  ' Returns   :
  ' John Doe 7/30/98 11AM
  ' Initrode Global Consulting (555) 555-5555
'move to next day  until week increases by one
Dim intWeek As Integer
Dim tmpWW As Integer
Dim testForMonday As Boolean
Dim dateFuture As Date
On Error GoTo fDaysLeftInWeek_Error
dateFuture = DateAdd("d", 1, dateToTest)

fDaysLeftInWeek = 0

intWeek = Format(dateToTest, "ww", vbMonday)
If intWeek = 52 Then 'for quick fix only 12/20/00 jd
'intWeek = 1 'turned off 01/03/02 jd
ElseIf intWeek = 53 Then 'fix 12/28/00 jd
intWeek = 0
End If

'dateFuture = #12/31/01#
'testForMonday = False

Do Until testForMonday = True

    If DCount("RowCount", "tbl_5Day", "[DAY]= #" & dateFuture & "#") = 0 Then
        dateFuture = DateAdd("d", 1, dateFuture)
        tmpWW = Format(dateFuture, "ww", vbMonday)
        If tmpWW = 52 Then  'for quick fix only 12/20/00 jd
        'intWeek = 1 'turned off 01/03/02 jd
        ElseIf intWeek = 53 Then 'fix 12/28/00 jd
        intWeek = 0
        End If
        If intWeek = 1 Then 'fix 01/03/02 12/31/01 is in week 1 and should be considered a Monday. jd
        'intWeek = 0
        End If

        testForMonday = (intWeek + 1 = tmpWW)
    Else
        dateFuture = DateAdd("d", 1, dateFuture)
        tmpWW = Format(dateFuture, "ww", vbMonday)
        If tmpWW = 52 Then 'for quick fix only 12/20/00 jd
        'intWeek = 1 'turned off 01/03/02 jd
        ElseIf intWeek = 53 Then 'fix 12/28/00 jd
        intWeek = 0
        End If
        If tmpWW = 1 Then 'fix 01/03/02 12/31/01 is in week 1 and should be considered a Monday. jd
        'tmpWW = 53 'turn off for q402 start
        End If
        testForMonday = (intWeek + 1 = tmpWW)
        fDaysLeftInWeek = fDaysLeftInWeek + 1
    End If
Loop

If Weekday(dateToTest) = 1 Or Weekday(dateToTest) = 7 Or (fDaysLeftInWeek = 0 And _
    DCount("RowCount", "tbl_5Day", "[DAY]= #" & dateToTest & "#") = 0) Then

fDaysLeftInWeek = -1
End If
Exit Function

fDaysLeftInWeek_Error:
MsgBox "Error:" & Error & " " & Error(Err), 16, "fDaysLeftInWeek_Error"

End Function

This function's purpose? To return a count of work days left in the week. It uses a table (pictured below) for date lookups, and occasionally adds more rows (and 5s) into this table when the application loads.

There's code that fails (often an accidental checkin with something hacky that gets forgotten), and code that takes special time and attention to fail spectacularly, of which this is a shining example. Maintenance is done by quick fixes, and version history is maintained via commented-out lines.

Like the beautiful rings of a tree, this festering mess has a lot to tell us.