Option Explicit 
 'Api declaration for suspending operation for a specified time
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 
 
Sub StatusMessage_Full() 
     '   Text strings that will be shown
    Const sz1stMsg As String = "NEW KB ALERT!!!!" 
    Const sz2ndMsg As String = "Log onto www.vbaexpress.com" 
    Const sz3rdMsg As String = "and Check out the kb!....." 
     
     
    Dim lCount As Long 
    Dim lMsgLen As Long 
    Dim i As Long 
    Dim bExit As Boolean 
     
     
     '   Blink an alert on the StatusBar first
     '   =================================================================
    While bExit = False 
         
        DoEvents 
         
        Application.StatusBar = sz1stMsg 
        Sleep 600& 
         
        Application.StatusBar = Empty 
        Sleep 600& 
         
        lCount = lCount + 1 
        If lCount = 3 Then bExit = True 
         
    Wend 
     '   =================================================================
     
     
     '   Then scroll the second message
     '   =================================================================
    lMsgLen = Len(sz2ndMsg) 
     
     
    For i = 1 To lMsgLen 
         
        Sleep 80& 
        DoEvents 
         
        Application.StatusBar = Left$(sz2ndMsg, i) 
         
    Next 
     
    Sleep 100& 
     '   =================================================================
     
     
     '   Reset the loop check / Counter
    bExit = False 
    lCount = 0 
     
     
     '   Deliver the 3rd and final message
     '   =================================================================
    lMsgLen = Len(sz3rdMsg) 
     
    While bExit = False 
         
        For i = 1 To lMsgLen * 2 
             
            Sleep 80& 
            DoEvents 
             
            Application.StatusBar = Mid$(Space(lMsgLen) & sz3rdMsg, i, lMsgLen) 
             
        Next 
         
         
        lCount = lCount + 1 
         '       in case loop counter {lCount} did not reset from first loop procedure,
         '       we add a check for a higher number to break out of the possible Endless Loop
        If lCount >= 1 Then bExit = True 
         
         
         
         '       If the loop counter is met, we exit the loop
        If bExit Then 
            Application.StatusBar = Empty 
            End 
        End If 
         
    Wend 
     
End Sub