A few years ago, Gregory was about to start development on a quoting system, when the client pulled-out all of a sudden. “We appreciate all the work you put in so far,” they told him, “but your overall estimate was just too much; we were able to find someone else who could develop this for less than a third of your cost.”

Gregory was surprised, especially since he had bid the system fairly low. He would have considered renegotiating, but the “someone else” they found was Fred Blogs, who happened to be the VP’s son-in-law. And one thing that Gregory had learned over the years is that it’s pretty hard to compete with nepotism.

That is, unless you wait it out. Less than twelve months after Fred’s system – a Microsoft Access database – had gone into production, the company’s process had slowed down so much that many employees were secretly moving back to paper quotes. This presented a problem on many levels, mostly in that reporting would be completely inaccurate.

Gregory agreed to help out, and his task was to completely gut what Fred had done (which, as it happened, ended up costing more than Gregory’s initial estimate) and replace it with something sensible. That, too, ended up costing more than his initial estimate, but the bright side is that the client was the proud owner of some interesting code. Namely, the MegaQuit():

Public Sub MegaQuit()
    Dim FredBlogs
    Dim intx As Integer
    Dim intCount As Integer
    
       intCount = Forms.Count - 1
       For intx = intCount To 0 Step -1
            If Forms(intx).Name <> "HiddenStarter" Then
                DoCmd.Close acForm, Forms(intx).Name
            End If
       Next
    If pboolCloseAccess <> True Then
        FredBlogs = MsgBox("Application will close.  Continue?", vbOKCancel, "EXIT")
        If FredBlogs = vbCancel Then
            DoCmd.OpenForm "Start_up"
        Else
            pboolCloseAccess = True
            DoCmd.Quit acQuitSaveAll
        End If
    End If
End Sub

Fred also left some other interesting tidbits in the code.

Public Static Sub FrErr(NameOfApp)
    Dim Count
    Count = Count + 1
    If Count < 5 Then
    On Error GoTo FrErrErr
        MsgBox "I'm broken. I Don't know what happened (I wasn't running at the time)," & vbCrLf & _
        "but I called: " & _
        NameOfApp & " and bang! The duff code came back with " & vbCrLf & _
        Err.Number & ":" & Err.Description & ". Sorry."
    Else
        MsgBox "I'm broken. I Don't know what happened (this isn't the first time)," & vbCrLf & _
        "but I called: " & _
        NameOfApp & " and bang! The duff code came back with " & vbCrLf & _
        Err.Number & ":" & Err.Description & ". I'm very sorry.  Have you considered restarting the PC?"
    End If
 
    Exit Sub
FrErrErr:
    MsgBox "I'm Broken.  I Don't know what happened and when I tried to find out I got an error.  Sorry.", , "Sorry"
End Sub
 
'A Pause function
Public Function HoldIt(Longish As Integer)
    Dim Startof
    Dim temp
    
    temp = 0
    Startof = Second(Now)
    
    Do
        temp = Second(Now) - Startof
    Loop Until temp > Longish
End Function

Gregory

[Advertisement] BuildMaster allows you to create a self-service release management platform that allows different teams to manage their applications. Explore how!