Create, Maintain, and Deliver better Microsoft Access, Office, VBA and VB6 code with Total Visual CodeTools

Total Visual CodeTools for Microsoft Access, Office, VBA, and VB6

Coding Tools for Microsoft Access, Office, VBA, and VB6

Free trial of Total Visual CodeTools for Microsoft Access, Office, VB6 and VBA

Sample Code Delivery: Before and After

The Code Delivery feature of Total Visual CodeTools lets you deliver more robust and compact solutions from your Microsoft Access/Office VBA and Visual Basic 6 (VB6) projects with these options:

Add Line Numbers

Line Numbers let your error handler pinpoint the exact line where a crash occurs with the ERL function. This lets you fix problems quicker and often eliminates the need for reproducible cases or end-user explanations.

Compact Code

Save space. Eliminate comments, blank lines, and indentations. Eliminate debugging code like Debug and Stop statements. You can also remove line continuation characters ( _) and combine multiple split lines into one long one.

Code Obfuscation

Rename variables to meaningless names, so recipients of your code are less able to understand and modify your work.

Here's a side-by-side example of how code is quickly transformed with the Code Delivery feature with variables renamed to "V" and a number:

Before Delivery

Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
    ' Minimize the database window and initialize the form.
    Dim strDir As String
    
    On Error GoTo HandleErr

    ' Make sure the current directory is the one where we are. This makes the "Show Me" stuff work
    strDir = CurrentDb.Name
    Do Until Right(strDir, 1) = "\"
        strDir = Left(strDir, Len(strDir) - 1)
    Loop
    ChDir strDir
    
    ' Minimize the database window.
    DoCmd.SelectObject acForm, "Switchboard", True
    DoCmd.Minimize

    ' Move to the switchboard page that is marked as the default.
    Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
    Me.FilterOn = True
    
    ' Open the reminders form
    OpenReminders
    
ExitHere:
    Exit Sub
    
HandleErr:
    Select Case Err
        Case Else
            MsgBox Err & ": " & Err.Description, vbCritical, _
             "Error in Form_Switchboard.Open"
    End Select
    Resume ExitHere
    Resume
End Sub

Private Sub Form_Current()

    ' Update the caption and fill in the list of options.

On Error GoTo HandleErr

    Me.Caption = Nz(Me![ItemText], "")
    FillOptions
    
ExitHere:
    Exit Sub
    
HandleErr:
    Select Case Err
        Case Else
            MsgBox Err & ": " & Err.Description, vbCritical, _
             "Error in Form_Switchboard.Current"
    End Select
    Resume ExitHere
    Resume
End Sub

Private Sub FillOptions()
    ' Fill in the options for this switchboard page.

    ' The number of buttons on the form.
    Const conNumButtons = 8
    
    Dim dbs As Database
    Dim rst As Recordset
    Dim strSQL As String
    Dim intOption As Integer

On Error GoTo HandleErr
    
    ' Set the focus to the first button on the form,
    ' and then hide all of the buttons on the form
    ' but the first.  You can't hide the field with the focus.
    Me![Option1].SetFocus
    For intOption = 2 To conNumButtons
        Me("Option" & intOption).Visible = False
        Me("OptionLabel" & intOption).Visible = False
    Next intOption
    
    ' Open the table of Switchboard Items, and find the first item for this Switchboard Page.
    Set dbs = CurrentDb()
    strSQL = "SELECT * FROM [Switchboard Items]"
    strSQL = strSQL & " WHERE [ItemNumber] > 0"
    strSQL = strSQL & " ORDER BY [ItemNumber];"
    Set rst = dbs.OpenRecordset(strSQL)
    
    ' If there are no options for this Switchboard Page,
    ' display a message.  Otherwise, fill the page with the items.
    If (rst.EOF) Then
        Me![OptionLabel1].Caption = "There are no items"
    Else
        While (Not (rst.EOF))
            Me("Option" & rst![ItemNumber]).Visible = True
            Me("OptionLabel" & rst![ItemNumber]).Visible = True
            Me("OptionLabel" & rst![ItemNumber]).Caption = rst![ItemText]
            rst.MoveNext
        Wend
    End If

ExitHere:
    On Error Resume Next
    ' Close the recordset
    rst.Close
    Exit Sub
    
HandleErr:
    Select Case Err
        Case Else
            MsgBox Err & ": " & Err.Description, vbCritical, _
             "Error in Form_Switchboard.FillOptions()"
    End Select
    Resume ExitHere
    Resume
End Sub

Private Function HandleButtonClick(intBtn As Integer)
    ' This function is called when a button is clicked.
    ' intBtn indicates which button was clicked.

    ' Constants for the commands that can be executed.
    Const conCmdGotoSwitchboard = 1
    Const conCmdOpenFormAdd = 2
    Const conCmdOpenFormBrowse = 3
    Const conCmdOpenReport = 4
    Const conCmdCustomizeSwitchboard = 5
    Const conCmdExitApplication = 6
    Const conCmdRunMacro = 7
    Const conCmdRunCode = 8
    Const conCmdOpenFormFilter = 9
    
    ' An error that is special cased.
    Const conErrDoCmdCancelled = 2501
    
    Dim dbs As Database
    Dim rst As Recordset

On Error GoTo HandleButtonClickErr

    ' Find the item in the Switchboard Items table
    ' that corresponds to the button that was clicked.
    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset("Switchboard Items", dbOpenDynaset)
    rst.FindFirst "[SwitchboardID]=" & Me![SwitchboardID]
    
    ' If no item matches, report the error and exit the function.
    If (rst.NoMatch) Then
        MsgBox "There was an error reading the Switchboard Items table."
        rst.Close
        dbs.Close
        Exit Function
    End If
    
    Select Case rst![Command]
        
        ' Go to another switchboard
        Case conCmdGotoSwitchboard
            Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=" & rst![Argument]
            
        ' Open a form in FilterbyForm mode
        Case conCmdOpenFormFilter
            DoCmd.OpenForm rst![Argument]
            DoCmd.RunCommand acCmdFilterByForm

        ' Open a form in Add mode
        Case conCmdOpenFormAdd
            DoCmd.OpenForm rst![Argument], , , , acAdd
       
        ' Open a form
        Case conCmdOpenFormBrowse
            DoCmd.OpenForm rst![Argument]

        ' Open a report
        Case conCmdOpenReport
            DoCmd.OpenReport rst![Argument], acPreview

        ' Customize the Switchboard
        Case conCmdCustomizeSwitchboard
            ' Handle the case where the Switchboard Manager is not installed (e.g. Minimal Install)
            On Error Resume Next
            Application.Run "ACWZMAIN.sbm_Entry"
            If (Err <> 0) Then MsgBox "Command not available."
            On Error GoTo 0
            ' Update the form
            Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
            Me.Caption = Nz(Me![ItemText], "")
            FillOptions

        ' Exit the application
        Case conCmdExitApplication
            CloseCurrentDatabase

        ' Run a macro
        Case conCmdRunMacro
            DoCmd.RunMacro rst![Argument]

        ' Run code
        Case conCmdRunCode
            Application.Run rst![Argument]

        ' Any other command is unrecognized
        Case Else
            MsgBox "Unknown option."
    
    End Select

    
HandleButtonClickExit:
    On Error Resume Next
    ' Close the recordset
    rst.Close
    Exit Function

HandleButtonClickErr:
    ' If the action was cancelled by the user for some reason, don't display an error message.
    ' Instead, resume on the next line.
    If (Err = conErrDoCmdCancelled) Then
        Resume Next
    Else
        MsgBox "There was an error executing the command.", _
         vbCritical, "Error in Form_Switchboard.HandleButtonClick()"
        Resume HandleButtonClickExit
    End If
    
End Function

After Delivery

Option Compare Database
Option Explicit
     
     Private Sub Form_Open(V1 As Integer)
     Dim V19 As String
100  On Error GoTo HandleErr
110  V19 = CurrentDb.Name
120  Do Until Right(V19, 1) = "\"
130  V19 = Left(V19, Len(V19) - 1)
140  Loop
150  ChDir V19
160  DoCmd.SelectObject acForm, "Switchboard", True
170  DoCmd.Minimize
180  Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
190  Me.FilterOn = True
200  OpenReminders
ExitHere:
210  Exit Sub
HandleErr:
220  Select Case Err
     Case Else
230  MsgBox Err & ": " & Err.Description, vbCritical, _
     "Error in Form_Switchboard.Open"
240  End Select
250  Resume ExitHere
260  Resume
     End Sub
     
     Private Sub Form_Current()
270  On Error GoTo HandleErr
280  Me.Caption = Nz(Me![ItemText], "")
290  FillOptions
ExitHere:
300  Exit Sub
HandleErr:
310  Select Case Err
     Case Else
320  MsgBox Err & ": " & Err.Description, vbCritical, _
     "Error in Form_Switchboard.Current"
330  End Select
340  Resume ExitHere
350  Resume
     End Sub
     
     Private Sub FillOptions()
     Const V12 = 8
     Dim V14 As Database
     Dim V18 As Recordset
     Dim V20 As String
     Dim V16 As Integer
360  On Error GoTo HandleErr
370  Me![Option1].SetFocus
380  For V16 = 2 To V12
390  Me("Option" & V16).Visible = False
400  Me("OptionLabel" & V16).Visible = False
410  Next V16
420  Set V14 = CurrentDb()
430  V20 = "SELECT * FROM [Switchboard Items]"
440  V20 = V20 & " WHERE [ItemNumber] > 0"
450  V20 = V20 & " ORDER BY [ItemNumber];"
460  Set V18 = V14.OpenRecordset(V20)
470  If (V18.EOF) Then
480  Me![OptionLabel1].Caption = "There are no items"
490  Else
500  While (Not (V18.EOF))
510  Me("Option" & V18![ItemNumber]).Visible = True
520  Me("OptionLabel" & V18![ItemNumber]).Visible = True
530  Me("OptionLabel" & V18![ItemNumber]).Caption = V18![ItemText]
540  V18.MoveNext
550  Wend
560  End If
ExitHere:
570  On Error Resume Next
580  V18.Close
590  Exit Sub
HandleErr:
600  Select Case Err
     Case Else
610  MsgBox Err & ": " & Err.Description, vbCritical, _
     "Error in Form_Switchboard.FillOptions()"
620  End Select
630  Resume ExitHere
640  Resume
     End Sub
     
     Private Function HandleButtonClick(V15 As Integer)
     Const V4 = 1
     Const V5 = 2
     Const V6 = 3
     Const V8 = 4
     Const V2 = 5
     Const V3 = 6
     Const V10 = 7
     Const V9 = 8
     Const V7 = 9
     Const V11 = 2501
     Dim V13 As Database
     Dim V17 As Recordset
650  On Error GoTo HandleButtonClickErr
660  Set V13 = CurrentDb()
670  Set V17 = V13.OpenRecordset("Switchboard Items", dbOpenDynaset)
680  V17.FindFirst "[SwitchboardID]=" & Me![SwitchboardID]
690  If (V17.NoMatch) Then
700  MsgBox "There was an error reading the Switchboard Items table."
710  V17.Close
720  V13.Close
730  Exit Function
740  End If
750  Select Case V17![Command]
     Case V4
760  Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=" & V17![Argument]
770  Case V7
780  DoCmd.OpenForm V17![Argument]
790  DoCmd.RunCommand acCmdFilterByForm
800  Case V5
810  DoCmd.OpenForm V17![Argument], , , , acAdd
820  Case V6
830  DoCmd.OpenForm V17![Argument]
840  Case V8
850  DoCmd.OpenReport V17![Argument], acPreview
860  Case V2
870  On Error Resume Next
880  Application.Run "ACWZMAIN.sbm_Entry"
890  If (Err <> 0) Then MsgBox "Command not available."
900  On Error GoTo 0
910  Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
920  Me.Caption = Nz(Me![ItemText], "")
930  FillOptions
940  Case V3
950  CloseCurrentDatabase
960  Case V10
970  DoCmd.RunMacro V17![Argument]
980  Case V9
990  Application.Run V17![Argument]
1000 Case Else
1010 MsgBox "Unknown option."
1020 End Select
HandleButtonClickExit:
1030 On Error Resume Next
1040 V17.Close
1050 Exit Function
HandleButtonClickErr:
1060 If (Err = V11) Then
1070 Resume Next
1080 Else
1090 MsgBox "There was an error executing the command.", _
     vbCritical, "Error in Form_Switchboard.HandleButtonClick()"
1100 Resume HandleButtonClickExit
1110 End If
     End Function