Use a Tab Control to Simulate a Subform

Subforms are wonderful for keeping a lot of related data together. They allow you to duplicate functionality across multiple forms, and also to pull data from different tables without the trouble of joining them in queries. Another function, which may seem incidental at first, is the ability to show, hide, enable, and disable a group of controls simply by setting the value on the subform control.
Once you become comfortable with using subforms, you may be tempted to create a subform just for the "incidental" purpose of grouping the controls. This practice, however, will quickly crowd your object explorer and clog up your system memory. Rather than using a subform, repurpose a tab control. Insert a tab control into your form and give it only one page. Then, set the "Style" property to "None." Now you have a page that behaves like a single-use subform: you can fill it with controls that you can move or hide at will, with a single command.

Library Databases - The What and Why

Do a Google search for "MS Access Library Database," and what you're going to see is a lot of suggestions for writing databases that manage libraries, one of the initial databases designed by beginning Access developers. This article is not about coding a library management database, it is about MS Access's intrinsic ability to use another MS Access database as a code library.

In the VBE, go to Tools -> References, click Browse, then hit the drop-down under "Files of type:" Along with .dll's and ActiveX controls, you'll discover that you can link any of several MS Access file types as a Reference. Now, normally I'm against references, but in this case I make an exception.

Say you have 10 interconnected MS Access front-ends running as part of a modular system. You probably want them to have a similar look and feel, with the same basic functionality. This means that a lot of the code procedures used in each database are going to be the same. Now, you could import and export modules across each database, but this has the potential to introduce serious version issues. Instead, create a code library database.

The library database is a convenient place to put all of the code that you will share across the databases you build - whether it be a password-masking procedure, the hash code you use for encrypting the passwords, or something as simple as a custom function for putting a Select Case statement onto a single line (like an If-Then to an IIf). Whenever you have code that you will want to reuse, put it into the library database. Then, instead of hunting multiple db modules for the right function to import, simply attach the library database as a Reference and - voila! - instant access to all of your custom classes and procedures.

A word of caution, however - library databases are very sensitive to environment changes. If you rename a library database or move it to a different folder, you will break each reference. If your database is accessed by multiple users, follow best practice and have them run local copies, with the library database in the same folder on the users' systems as the front ends, in order to mitigate that issue.

And a further note - even though some of Microsoft's documentation appears to hint that you can open objects, such as forms and reports, in a library database using code in the library database, the fact is that you can't. The application environment simply doesn't allow for it. If you do want to create a forms or reports library that is accessible from all of your other databases, you can handle it by using an Access automation object.

Add Robust Global Error Handling to Your Procedures - Automagically!

  If you're anything like me, you consistently skip putting error handling into your code. Not because you don't think error handling is important, but because coding it is tedious and you want to get to the good, juicy code, the stuff that makes your app awesome. But no one creates bulletproof code, so once you release it for testing, your users start reporting errors crashing your amazing app. You lose credibility, and you can't sleep at night worrying that you'll be unable to get a new contract when your client cuts you loose with a bad reference.

   So maybe that scenario isn't entirely applicable, but it can happen if you ignore error handling. A robust error handling system is a must for any app, but you won't find many code samples available on the Internet showing you how to apply a robust error handling solution. So I've put this module together; it shows both my global error handling procedure and how I programmatically automate the deployment into my applications.

    Simple error handling pops up a MsgBox in order to avoid breaking the code. Good error handling logs the errors. My solution takes both and adds emailing an error notification to a GMail address you set up yourself (see http://tophersaccesstips.blogspot.com/2013/10/avoid-outlook-integration-send-email.html). But the real elegance in this code module is in the deployment routine - it finds every code module - standard, form, and report, in your application and adds the global error handler to each procedure (function or subroutine) in the module. Here are the steps:

1. Insert the following code module into a database. If you are developing multiple databases for a single client, the best place for this module is a shared "library" database (more on using library databases in a future post).

2. Run the InsertErrorHandling function by passing it the path to a valid MS Access database. In the Immediate window, Type InsertErrorHandling "Path\To\My\Database.accdb"

3. The procedure will open each code module in your database and add error handling. You may have to babysit this process, especially if your application contains a lot of orphaned objects.

4. When the procedure is finished, it will close the database and open a log file containing all of the modules and procedures it evaluated, along with whether it already had error-checking or not (True if it did, False if not). Perhaps counterintuitively, a False result means the procedure did add error checking to the procedure.

5. Reopen the database, checking to ensure that everything is working properly.

6. Even if everything looks okay, you should still compile the code to be sure. In the VBE, run the compiler (Debug -> Compile Database) and fix any errors that are noted. The better your code is written, the fewer the errors you should need to fix.

7. Enjoy your new, fully error-handled database!

NOTE: This module does not convert macros to VBA code to add error handling. I'm still looking into making that functionality available to the procedure.

Option Compare Database
Option Explicit
'***********************************************************
'  Module GlobalErrorHandling
'  Written by Topher Ritchie, tophersaccesstips.blogspot.com
'  You are free to use, modify, or distribute this code, provided
'  this header remains in place.
'***********************************************************

'psubGlobalErrHandler
'  Provides consistent error handling
'  Uses the SendSMTP function available at
'  http://tophersaccesstips.blogspot.com/2013/10/avoid-outlook-integration-send-email.html)

Public Sub psubGlobalErrHandler(procedure_name As String, object_name As String, err_num As Long, err_desc As String)
On Error Resume Next
Dim fso As Object
Dim logfile As Object
Dim strError As String

    MsgBox "Error " & err_num & " in " & procedure_name & ":" & vbCrLf & err_desc & vbCrLf & vbCrLf & "Please contact your application support team."
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set logfile = fso.OpenTextFile(Environ("HOMEDRIVE") & Environ("HOMEPATH") & "\YourApp_errors.log", ForAppending, True)
    strError = CurrentDb.Name & "; " & CurrentProject.Name & "; " & procedure_name & "; " & object_name & "; " & err_num & "; " & err_desc & "; " & Now() & "; " & TempVars!CurrentUser & "; "
    logfile.WriteLine strError
        'add session data when available (open modules, windows, etc.) to handle tricky errors
    If SendSMTP("you.developer@gmail.com", "Error triggered in Your App.", strError) Then
        logfile.WriteLine "Error report sent"
    Else
        logfile.WriteLine "Error report NOT sent"
    End If
 
    logfile.Close
 
    Set logfile = Nothing
    Set fso = Nothing
 
End Sub

'The remainder of this module is for inserting Global Error Handling into procedures
'  that do not already have it (in standard, form, and report modules), populating
'  for psubGlobalErrHandler

Public Sub InsertErrorHandling(ByVal strDatabasePath As String)
    Dim appAccess As Object
    Dim obj As Object
    Dim mdl As Object
    Dim fs As Object, txtfile As Object

    Set appAccess = New Access.Application

    appAccess.OpenCurrentDatabase strDatabasePath
 
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set txtfile = fs.OpenTextFile(CurrentProject.Path & "\errhandling.txt", 8, True)
    txtfile.WriteLine appAccess.CurrentDb.Name
    txtfile.WriteLine ""
    txtfile.Close
    Set txtfile = Nothing
    Set fs = Nothing
 
    For Each obj In appAccess.CurrentProject.AllModules
        On Error GoTo NextModule
        appAccess.DoCmd.OpenModule obj.Name
        FixModule appAccess.Modules(obj.Name)
        appAccess.DoCmd.Close acModule, obj.Name, acSaveYes
NextModule:
    Next obj
     
    For Each obj In appAccess.CurrentProject.AllForms
        On Error GoTo NextForm
        appAccess.DoCmd.OpenForm obj.Name, acDesign
        If appAccess.Forms(obj.Name).HasModule = True Then
            FixModule appAccess.Forms(obj.Name).Module
        End If
        appAccess.DoCmd.Close acForm, obj.Name, acSaveYes
NextForm:
    Next obj
 
    For Each obj In appAccess.CurrentProject.AllReports
        On Error GoTo NextReport
        appAccess.DoCmd.OpenReport obj.Name, acDesign
        If appAccess.Reports(obj.Name).HasModule = True Then
            FixModule appAccess.Reports(obj.Name).Module
        End If
        appAccess.DoCmd.Close acReport, obj.Name, acSaveYes
NextReport:
    Next obj
 
    On Error GoTo 0
    appAccess.CloseCurrentDatabase
    appAccess.Quit
    Set appAccess = Nothing
 
    Shell "notepad.exe """ & CurrentProject.Path & "\errhandling.txt"""

End Sub

Public Sub FixModule(mdl As Module)
    Dim lngCount As Long
    Dim lngCountDecl As Long
    Dim lngI As Long
    Dim strProcName As String
    Dim strInsert As String
    Dim astrProcNames() As String
    Dim aboolProcErrHandling() As Boolean
    Dim intI As Integer
    Dim i As Integer
    Dim strMsg As String
    Dim strComment As String
    Dim lngR As Long
    Dim fs As Object, txtfile As Object
 
    If mdl.Type = 8 Then
        'module type 8 is a Class Module.
        'we'll just let the calling procedure throw the error
        'rather than dealing with error handling in the class
        'so we'll exit the sub without doing anything
        Exit Sub
    End If
 
    lngCount = mdl.CountOfLines
    lngCountDecl = mdl.CountOfDeclarationLines
    strProcName = mdl.ProcOfLine(lngCountDecl + 1, lngR)
    intI = 0
    ReDim Preserve astrProcNames(intI)
    ReDim Preserve aboolProcErrHandling(intI)
 
    astrProcNames(intI) = strProcName
    aboolProcErrHandling(intI) = False

    For lngI = lngCountDecl + 1 To lngCount
        If InStr(mdl.Lines(lngI, 1), "On Error") > 0 Then aboolProcErrHandling(intI) = True
        If strProcName <> mdl.ProcOfLine(lngI, lngR) Then
            intI = intI + 1
            strProcName = mdl.ProcOfLine(lngI, lngR)
            ReDim Preserve astrProcNames(intI)
            ReDim Preserve aboolProcErrHandling(intI)
            astrProcNames(intI) = strProcName
            aboolProcErrHandling(intI) = False
        End If
    Next lngI
 
    strMsg = "Procedures in module '" & mdl.Name & "': " & vbCrLf & vbCrLf
 
    For intI = 0 To UBound(astrProcNames)
 
        If astrProcNames(intI) = "InputBoxDK" Then
            Stop
        End If
     
        strMsg = strMsg & astrProcNames(intI) & "; " & aboolProcErrHandling(intI) & vbCrL
           
        If aboolProcErrHandling(intI) = False And Not Nz(astrProcNames(intI)) = "" Then
         
            Do Until Not Replace(mdl.Lines(mdl.ProcStartLine(astrProcNames(intI), lngR), 1), " ", "") = ""
                mdl.DeleteLines mdl.ProcStartLine(astrProcNames(intI), lngR), 1
            Loop
         
            'take out any initial comments blocks, store them to put back after inserting "On Error"
            strComment = ""
            Do Until Not InStr(Replace(mdl.Lines(mdl.ProcStartLine(astrProcNames(intI), lngR), 1), " ", ""), "'") = 1
                strComment = strComment & mdl.Lines(mdl.ProcStartLine(astrProcNames(intI), lngR), 1) & vbCrLf
                mdl.DeleteLines mdl.ProcStartLine(astrProcNames(intI), lngR), 1
            Loop
         
            'Find the first line after the procedure start line (for line continuation (_) handling)
            i = 0
            Do While InStr(Replace(mdl.Lines(mdl.ProcStartLine(astrProcNames(intI), lngR) + i, 1), " ", ""), "_") = Len(Replace(mdl.Lines(mdl.ProcStartLine(astrProcNames(intI), lngR) + i, 1), " ", ""))
                i = i + 1
            Loop
            mdl.InsertLines mdl.ProcStartLine(astrProcNames(intI), lngR) + i + 1, "On Error Goto Err_Handler"
         
            strInsert = "Exit_Err:" & vbCrLf & _
                            vbTab & "Exit " & IIf(InStr(mdl.Lines(mdl.ProcStartLine(astrProcNames(intI), lngR), 1), "Function") > 0, "Function", "Sub") & vbCrLf & _
                            "Err_Handler:" & vbCrLf & _
                            vbTab & "psubGlobalErrHandler """ & astrProcNames(intI) & """, """ & mdl.Name & """, Err.Number, Err.Description" & vbCrLf & _
                            vbTab & "Resume Exit_Err"
            If Not intI = UBound(astrProcNames) Then
                mdl.InsertLines mdl.ProcStartLine(astrProcNames(intI + 1), lngR) - 1, strInsert
            Else
                'remove any trailing spaces or comments in the module before inserting the error handling block
                Do Until Not mdl.Lines(mdl.CountOfLines, 1) = "" And Not InStr(Replace(mdl.Lines(mdl.CountOfLines, 1), " ", ""), "'") = 1
                    mdl.DeleteLines mdl.CountOfLines, 1
                Loop
                mdl.InsertLines mdl.CountOfLines, strInsert
            End If
            'put the intitial comment block back in
            mdl.InsertLines mdl.ProcStartLine(astrProcNames(intI), lngR), strComment
        End If
    Next intI

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set txtfile = fs.OpenTextFile(CurrentProject.Path & "\errhandling.txt", 8, True)
    txtfile.WriteLine strMsg
    txtfile.Close
    Set txtfile = Nothing
    Set fs = Nothing
 
End Sub



UPDATE: After help from some of my fellow experts at bytes.com, I now have a function that finds and converts the macros in each form and report. I had hoped for something as elegant as the intrinsic property "HasModule" for the form, but instead we have to check each form and control property for macros. You'll have to babysit the code as it runs to click on the conversion message, but it does the job. Add the following line in the InsertErrorHandling procedure just below the line:
appAccess.DoCmd.OpenForm obj.Name, acDesign:

ConvertFormMacros appAccess.Forms(obj.Name)

and in the corresponding location for reports: ConvertReportMacros appAccess.Reports(obj.Name)

It is very important to pass the form or report with obj.Name, rather than obj itself; obj is dimensioned as an "object" data type, so the properties intrinsic to forms and reports are not available to it. By passing the form or report with obj's Name property to the functions, we're able to access all of the properties that we need to check.

Insert these functions into your module, and then run it against a database with macros to see it convert the macros to VBA and then add the global error handling routine to them.

Public Function ConvertReportMacros(r As Report)
    Dim c As Control
    Dim p As Property
    On Error Resume Next
 
    For Each p In r.Properties
        If IsEvent(p.Name) Then
            If Not (Nz(p.Value) = "[Event Procedure]" Or Nz(p.Value) Like "=*" Or Nz(p.Value) = "") Then
                r.Application.DoCmd.RunCommand acCmdConvertMacrosToVisualBasic
            End If
        End If
    Next p
 
    For Each c In r.Controls
        For Each p In c.Properties
            If IsEvent(p.Name) Then
                If Not (Nz(p.Value) = "[Event Procedure]" Or Nz(p.Value) Like "=*" Or Nz(p.Value) = "") Then
                    r.Application.DoCmd.RunCommand acCmdConvertMacrosToVisualBasic
                End If
            End If
        Next p
    Next c
End Function

Public Function ConvertFormMacros(f As Form)
    Dim c As Control
    Dim p As Property
    On Error Resume Next
 
    For Each p In f.Properties
        If IsEvent(p.Name) Then
            If Not (Nz(p.Value) = "[Event Procedure]" Or Nz(p.Value) Like "=*" Or Nz(p.Value) = "") Then
                f.Application.DoCmd.RunCommand acCmdConvertMacrosToVisualBasic
            End If
        End If
    Next p
 
    For Each c In f.Controls
        For Each p In c.Properties
            If IsEvent(p.Name) Then
                If Not (Nz(p.Value) = "[Event Procedure]" Or Nz(p.Value) Like "=*" Or Nz(p.Value) = "") Then
                    f.Application.DoCmd.RunCommand acCmdConvertMacrosToVisualBasic
                End If
            End If
        Next p
    Next c
 
End Function


Public Function IsEvent(strProperty As String)
    Select Case strProperty
        Case "OnActivate", "AfterDelConfirm", "AfterInsert", "AfterUpdate", "OnApplyFilter", "BeforeDelConfirm", _
                "BeforeInsert", "BeforeUpdate", "OnChange", "OnClick", "OnClose", "OnCurrent", "OnDblClick", "OnDeactivate", _
                "OnDelete", "OnDirty", "OnEnter", "OnError", "OnExit", "OnFilter", "OnFormat", "OnGotFocus", "OnKeyDown", _
                "OnKeyPress", "OnKeyUp", "OnLoad", "OnLostFocus", "OnMouseDown", "OnMouseMove", "OnMouseUp", "OnNoData", _
                "OnNotInList", "OnOpen", "OnPage", "OnPrint", "OnResize", "OnRetreat", "OnTimer", "OnUnload", "OnUpdated"
            IsEvent = True
        Case Else
            IsEvent = False
    End Select
End Function

Avoid Outlook Integration - Send Email using SMTP via GMail

Outlook integration in MS Access is a real pain. Not only is it prone to version issues, but the "Outlook Security" debacle is still fresh in the minds of many a developer. Although integration with the rest of the Office suite (particularly Excel) is a wonderful feature of Access, I find it best to avoid any dependency on Outlook. Not only does it depend on your client having a properly configured Outlook account, any emails sent from your app will show the user's email as the "From" address, which can be undesirable behavior.  So, if you're trying to get away from using methods like SendObject or (for more advanced developers) Outlook automation, what options do you have? The best option, in my opinion, is using GMail.

GMail? How could I automate a web-based email service through a desktop database, you might ask. In the past, Microsoft made this easy by packaging the Collaboration Data Objects (CDO) dll that included the SMTP schema directly within Windows. That stopped with Windows Vista, and many developers gave up on sending via SMTP and reluctantly moved to Outlook integration. Even if you are able to download the CDO libraries, you are still stuck with the problem of packaging the dll with your application and risking broken reference issues. However, it is possible to access Microsoft's SMTP services schema directly, without dealing with dll's, to push your email out. Here's how:

1. Set up a GMail account for your application to send through (e.g., your.app@gmail.com).

2. Place the following code module in your application (with appropriate changes for your app).

3. Call the function from your application's code using the "Usage" suggestion in the module header. Note that you can send to multiple recipients by separating them with a semicolon (;) and attach multiple files using the same method.

4. Enjoy having total control over your emails!

Option Compare Database
Option Explicit

'***********************************************************
'  Module SendViaGMail
'  Written by Topher Ritchie, tophersaccesstips.blogspot.com
'  Send emails via a GMail account
'  Usage:
'  SendSMTP("user1@email.com; user2@email.com, etc.","Subject string", _
'      "Body string","C:\Path\To\Attachment1.file; C:\Path\To\Attachment2.file, etc.")
'  Returns a Boolean value of True if no errors were noted.
'  You are free to use, modify, or distribute this code, provided
'  this header remains in place.
'***********************************************************

Public Function SendSMTP(ToString As String, Optional SubjectString As String, Optional BodyString As String, Optional AttachmentString As String) As Boolean
Dim iCfg As Object
Dim iMsg As Object
Dim i As Integer
On Error GoTo Err_Handler:

    Set iCfg = CreateObject("CDO.Configuration")
    Set iMsg = CreateObject("CDO.Message")

    With iCfg.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "your.app"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "your.password"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendemailaddress") = "your.app@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Update
    End With

    With iMsg
        .Subject = SubjectString
        .To = ToString
        .HTMLBody = BodyString
        If Not (IsMissing(AttachmentString) Or Nz(AttachmentString) = "") Then
            For i = 1 To CountInStr(AttachmentString, ";") + 1
                .AddAttachment Left(AttachmentString, IIf(Nz(InStr(AttachmentString, ";")) = 0, Len(AttachmentString), Nz(InStr(AttachmentString, ";")) - 1))
                AttachmentString = Right(AttachmentString, IIf(Nz(InStr(AttachmentString, ";")) = 0, Len(AttachmentString), Nz(InStr(AttachmentString, ";")) + 1))
            Next i
        End If
     
         Set .Configuration = iCfg
        .Send
    End With

    Set iMsg = Nothing
    Set iCfg = Nothing
 
    SendSMTP = True
 
Err_Exit:
    Exit Function

Err_Handler:
    SendSMTP = False

Resume Err_Exit

End Function


Public Function CountInStr(StringToCheck As String, StringToFind As String) As Long
    CountInStr = (Len(StringToCheck) - Len(Replace(StringToCheck, StringToFind, ""))) / Len(StringToFind)
End Function