Сохранить рекурсивно файл

[Azz100]

Здравствуйте, нужна кнопка, чтобы можно было сохранить ткущую экселовскую книгу в папку, и его копии (без переименования) во все подпапки находящееся в ней автоматически.
Если такой диалог невозможен или трудно достигаем, то можно путь прописать в в самом скрипте.

[Step_UA]

Sub Записать()
  On Error GoTo ex
  ActiveWorkbook.Save
  On Error GoTo 0
  recSave CreateObject("Scripting.FileSystemObject").GetFolder(ActiveWorkbook.Path & Application.PathSeparator)
ex:
End Sub

Sub recSave(ByVal fso As Object)
    For Each SubDir In fso.SubFolders
        ActiveWorkbook.SaveCopyAs SubDir.Path & Application.PathSeparator & ActiveWorkbook.Name
        recSave SubDir
    Next
End Sub