This set of procedures can be used in Microsoft Access to collect messages during a process to display to the user after the process is complete.  It provides a good example of how to use collections in VBA.

For instance, you could track the progress of some calculations and then message the user like this:

InitMsg
' Track the calculation numbers.
dblRatio = DLookup("Ratio","Settings")
AddMsg "Ratio: " & dblRatio
dblOrders = DCount("OrderNumber","Orders")
AddMsg "Orders: " & dblOrders
dblOrdersRatio = dblRatio * dblOrders
AddMsg "Orders Ratio: " & dblOrdersRatio
' Message the user the results.
MsgBox Msg, , "Calculation"
QuitMsg

Code:

Option Compare Database
Option Explicit

' basMsg.bas Version 1.0.0
' Copyright © 2009 Extra Mile Data, www.extramiledata.com.
' For questions or issues, please contact [email protected].
' Use (at your own risk) and modify freely as long as proper credit is given.

' This set of functions is used to manage a collection of messages.
' 1. Call InitMsg to initialize the collection.
' 2. Call AddMsg to add to the collection.
' 3. Call Msg to see a comma-delimited list of messages in the collection.
' 3. Call EmptyMsg to empty the collection if you need to start over.
' 4. Call QuitMsg to remove the collection.

' This is the global collection.
Public gcolMsg As Collection

Public Sub TestMsg()
' This is an example of how the set of procedures work.
   
    ' Initialize the collection.
    InitMsg
    ' Add messages.
    AddMsg "comment 1"
    AddMsg "comment 2"
    AddMsg "Comment 3"
    ' Retrieve the messages (in the Immediate window for this example).
    Debug.Print "Before:" & vbCrLf & Msg
    ' Empty the collection to start again.
    EmptyMsg
    ' Now there should be no messages.
    Debug.Print "After:" & vbCrLf & Msg
    ' Remove the collection.
    QuitMsg
   
End Sub

Public Sub InitMsg()
' This procedure initializes the collection.
    Set gcolMsg = New Collection
End Sub

Public Function QuitMsg()
' This procedure removes the collection.
    Set gcolMsg = Nothing
End Function

Public Sub AddMsg(Msg As String)
' This procedure adds a new message to the collection.
   
    ' If the message collection is initialized,
    ' then add Msg to the collection.
    If Not (gcolMsg Is Nothing) Then gcolMsg.Add Msg
   
End Sub

Public Function Msg() As Variant
' This function returns a list of messages from the collection, separated
' by carriage-return/line feeed.  If there are no messages, it returns Null.
On Error GoTo Err_Msg

    Dim varMsg
    Dim strResult As String
   
    ' If the collection was not initialized, then just return
    ' a Null.
    If gcolMsg Is Nothing Then
        Msg = Null
        Exit Function
    End If
   
    ' Initialize the result variable.
    strResult = ""
   
    ' Loop through all the messages in the collection, adding each
    ' to strResult, separated by a carriage return.
    For Each varMsg In gcolMsg
        If Len(strResult) = 0 Then
            strResult = varMsg
        Else
            strResult = strResult & vbCrLf & varMsg
        End If
    Next
   
    ' If there were no messages, then pass back a Null.
    ' Otherwise, return the result.
    If Len(strResult) = 0 Then
        Msg = Null
    Else
        Msg = strResult
    End If

Exit_Msg:
    On Error Resume Next
    Exit Function

Err_Msg:
    MsgBox Err.Number & " " & Err.Description, vbCritical, "Msg()"
    Msg = Null
    Resume Exit_Msg
End Function

Public Function EmptyMsg() As Boolean
' This function empties all the messages from the collection.
On Error GoTo Err_EmptyMsg

    Dim varMsg
   
    ' If the collection was not initialized, then just return
    ' a true.
    If gcolMsg Is Nothing Then
        EmptyMsg = True
        Exit Function
    End If
   
    ' Loop through all the messages in the collection, starting at
    ' the largest index and working back to 1, removing each one.
    For varMsg = gcolMsg.Count To 1 Step -1
        gcolMsg.Remove (varMsg)
    Next
   
    EmptyMsg = True
   
Exit_EmptyMsg:
    On Error Resume Next
    Exit Function

Err_EmptyMsg:
    MsgBox Err.Number & " " & Err.Description, vbCritical, "EmptyMsg()"
    EmptyMsg = False
    Resume Exit_EmptyMsg
End Function

Download Code:

basMsg.zip