Forms: Display a dialog box for a specified duration

     The built-in MsgBox function doesn't allow you to automatically close it after a specified duration.  A workaround is to create a form and close it through it's Timer event.

    Another alternative is to build the form on the fly by using the CreateForm and CreateControl methods.  This function uses these methods to create a form and automatically close it after a specified interval.

'************* Code Start **************
' This code was originally written by Michael Bedward.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Michael Bedward
'
' Display a simple popup message dialog for a given number of
' seconds.
'
' This code was written by Michael Bedward
' mbedward@ozemail.com.au
' March 31, 1999.
'
' You are free to distribute and use this code as you wish
' but it would be nice if you credit the original author
' (by leaving this notice intact).  Improvements will be
' gratefully accepted.
'
' Modifications:
'   April 12, 1999
'   Added modifications suggested by Mark West (mrwest@engin.umich.edu):
'   code to auto-size form according to label size;
'   optional args to set font name and size;
'   code to delete form object.
'
'   April 16,1999
'   Added error handler as suggested by Dev Ashish (dash10@hotmail.com).
'
Sub mxbPopupMessage(ByVal message As String, _
                    Optional ByVal title As Variant, _
                    Optional ByVal duration As Single, _
                    Optional strFontName As String, _
                    Optional intFontSize As Integer)
    Dim f As Form
    Dim lbl As Label
    Dim dblWidth As Double
    Dim myName As String
    Dim savedForm As Boolean
    
    ' used for error handling
    '
    savedForm = False
    
    ' turn off screen repainting so that we don't see the
    ' form being created
    '
    On Error GoTo ErrorHandler
    Application.Echo False
    
    ' make a simple blank form
    '
    Set f = CreateForm
    myName = f.Name
    f.RecordSelectors = False
    f.NavigationButtons = False
    f.DividingLines = False
    f.ScrollBars = 0  ' none
    f.PopUp = True
    f.BorderStyle = acDialog
    f.Modal = True
    f.ControlBox = False
    f.AutoResize = True
    f.AutoCenter = True
    
    ' set the title
    '
    If IsMissing(title) Then
        f.Caption = "Info"
    Else
        f.Caption = title
    End If
    
    ' add a label for the message
    '
    Set lbl = CreateControl(f.Name, acLabel)
    lbl.Caption = message
    lbl.BackColor = 0 ' transparent
    lbl.ForeColor = 0
    lbl.Left = 100
    lbl.Top = 100
    If strFontName <> "" Then lbl.FontName = strFontName
    If intFontSize > 0 Then lbl.FontSize = intFontSize
    lbl.SizeToFit
    dblWidth = lbl.Width + 200
    f.Width = dblWidth - 200
    f.Section(acDetail).Height = lbl.Height + 200
    
    ' display the form (first close and save it so that when
    ' it is reopened it will auto-centre itself)
    '
    DoCmd.Close acForm, myName, acSaveYes
    savedForm = True
    DoCmd.OpenForm myName
    DoCmd.MoveSize , , dblWidth
    DoCmd.RepaintObject acForm, myName

    ' turn screen repainting back on again
    '
    Application.Echo True

    ' display form for specifed number of seconds
    '
    If duration <= 0 Then duration = 2
    Dim startTime As Single
    startTime = Timer
    While Timer < startTime + duration
    Wend
    
    ' close and delete the form
    '
    DoCmd.Close acForm, myName, acSaveNo
    DoCmd.DeleteObject acForm, myName
    Exit Sub
    
ErrorHandler:
    Application.Echo True
    Dim i As Integer
    For Each f In Forms
      If f.Name = myName Then
        DoCmd.Close acForm, myName, acSaveNo
        Exit For
      End If
    Next f
    If savedForm Then
      DoCmd.DeleteObject acForm, myName
    End If
               
End Sub
'************* Code End **************