[AccessD] List box as a status box

I am not sure I would use the listbox because they are limited in terms of
how much can be displayed. I would probably go with a datasheet subform at a
minimum, if you *really* do give up textboxes. But I like textboxes for this
use. I use a memo field and only a single record in the textbox. Set enter
key behavior to add new line, and scroll to vertical. Note I trim off the
entries I don't want to retain... In this implementation I have two
textboxes... one holds the accumulated events (last 15 items only) and one
holds new event I want to add

Option Compare Database
Option Explicit
'For module
Private Sub cmdAddEvent_Click()
If Nz(Me.txtNewEvent, "") <> "" Then
  RecordLogEntry CurrentDb, Me.txtEvents, Me.txtNewEvent
End If
End Sub

Private Sub Form_Load()
Dim R As DAO.Recordset
txtEvents = ""
Set R = CurrentDb.OpenRecordset("Select First(EventField) as EventToShow
>From TblEventLog Group by EventField")
If Not R.EOF Then
  txtEvents = R!EventToshow
End If
End Sub

'Then this goes in standard module... works pretty well.
Function RecordLogEntry(MyDB As DAO.Database, Ctrl As Control,
sWhateverEventStringIs As String)
Dim bStoreLocked  As Boolean
Dim strEVENTBREAK As String
Const iMaxEntries = 15
Dim RstEventLog As DAO.Recordset
Dim sEntry As String
Dim sCurrentLog As String
Const sLogStart As String = "<==============   "
Const sLogEnd As String = "   ==============>"
strEVENTBREAK = sLogStart & Format(Now(), "m/d/yyyy h:mm AM/PM") & sLogEnd &
vbCrLf

Set RstEventLog = MyDB.OpenRecordset("Select EventField From TblEventLog")
sEntry = strEVENTBREAK & sWhateverEventStringIs
On Error Resume Next
RstEventLog.MoveFirst
On Error GoTo Err_Handler
If Not RstEventLog.EOF Then
  sCurrentLog = KeepMostRecent(RstEventLog.Fields(0), iMaxEntries,
sLogStart)
  RstEventLog.Edit
  RstEventLog.Fields(0) = sEntry & vbCrLf & sCurrentLog  'Newest first
  RstEventLog.Update
Else
  RstEventLog.AddNew
  RstEventLog.Fields(0) = sEntry
  RstEventLog.Update
End If
If TypeOf Ctrl Is Access.TextBox Then

  bStoreLocked = Ctrl.Locked
  Ctrl.Locked = False
  RstEventLog.Requery
  Ctrl.Value = RstEventLog.Fields(0)
  Ctrl.Locked = bStoreLocked
End If

Exit Function

Err_Handler:
MsgBox Err.Number & " - " & Err.Description

End Function

Function KeepMostRecent(ByVal str As String, ByVal iMax As Long, ByVal
sLogStart As String) As String
Dim iOccurrences As Long
iOccurrences = (Len(str) - Len(Replace$(str, sLogStart, ""))) /
Len(sLogStart)
If iOccurrences >= iMax Then
  'Remove last one
  KeepMostRecent = Left(str, InStrRev(str, sLogStart) - 1)
Else
  KeepMostRecent = str
End If

End Function