Excel VBA File System Object

I'm using this code to move files to a new folder. I tried using an Error Handler to give a 'friendly message' if there are no files to move. BUT instead I get the standard message. How can I force a 'friendly message' please?

Sub MoveFilesToArchiveFolder()

    'by Ron de Bruin (see last example)
    'http://www.rondebruin.nl/win/s3/win026.htm

    On Error GoTo ErrHandler:

    'move files to archive folder
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String
    Dim FNames As String

    FromPath = "C:\Test\Reports"
    ToPath = "C:\Test\Reports\Old " & Format(Now, "yyyy-mm-dd h-mm-ss") _
           & "" & "\"
           
    FileExt = "*.*"
    
    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    FNames = Dir(FromPath & FileExt)
    If Len(FNames) = 0 Then
        MsgBox "No files in " & FromPath
        Exit Sub
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    FSO.CreateFolder (ToPath)

    FSO.MoveFile Source:=FromPath & FileExt, Destination:=ToPath

    Exit Sub
    
ErrHandler:
    ' error handling code
    MsgBox "There are no reports to archive"

End Sub

Select allOpen in new window