---Posted by Michael Bedward---

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 buid 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 **************

' 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 **************