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.