Files move to a subfolder

Hi,

I want move all the xls files from a folder (C:\Test) to a subfolder (C:\Test\2009), but not move "ThisWorkbook".

I try this

 Dim X
Dim FromFder, ToFder, ToFder2
Dim fso, GtName, fsofile, FileNw

Set X = ThisWorkbook
FromFder = X.Path
    GtName = InputBox("Pl Enter Subfolder Name", " Prog", Year(Now()) - 1)
ToFder = FromFder & "\" & GtName
    MkDir ToFder
ToFder2 = ToFder
FileNw = "\*.xls"
Set fso = CreateObject("Scripting.FileSystemObject")
        FileNw = Dir(FromFder & FileNw)

    Do While FileNw <> "" And FileNw <> ThisWorkbook.Name
Set fsofile = fso.GetFile(FileNw)
        fsofile.MoveFile FromFder, ToFder
    Loop

but isnt working at all.

Thanks in advance for any help