List all the directories under the current one

Maybe something like

Select[FileNames["*", "", Infinity], DirectoryQ]

If I'm not mistaken the second asterisk in your line

FileNames["*",{"*"},Infinity]

should be replaced with the location of the directory you want to look in.

In case of the directory where your notebook lives in this would be:

FileNames["*", {NotebookDirectory[]}, Infinity]

or, for the current directory, this would be:

FileNames["*", {Directory[]}, Infinity]

I recommend an external command approach. On Windows this looks like this:

command = "!dir \"" <> Directory[] <> "\" /A:D /S /B";

ReadList[command, String]

This can be many times faster than the Select - FileNames method.

Select[
  FileNames["*", "C:\\Data & Images", Infinity],
  DirectoryQ
] // Length // AbsoluteTiming
{6.7413856, 5693}
command = "!dir \"" <> "C:\\Data & Images" <> "\" /A:D /S /B";
ReadList[command, String] // Length // AbsoluteTiming
{0.3900223, 5693}