Dim s
s = ThisWorkbook.Path & TextBox1
MkDir s

s = ThisWorkbook.Path & "\" & TextBox1

MkDir "C:\Fold1\"
MkDir "C:\Fold1\Fold2\"
MkDir "C:\Fold1\Fold2\Fold3\"  ' намек понял?

Private Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" ( _
                    ByVal Hwnd As Long, _
                    ByVal pszPath As String, _
                    ByVal psa As Any) As Long
Private Const ERROR_SUCCESS = 0&                    ' The operation completed successfully
Private Const ERROR_BAD_PATHNAME = 161&             '* The specified path is invalid
Private Const ERROR_FILENAME_EXCED_RANGE = 206&     ' The filename or extension is too long
Private Const ERROR_PATH_NOT_FOUND = 3&             ' The system cannot find the path specified
Private Const ERROR_FILE_EXISTS = 80&               ' The file exists
Private Const ERROR_ALREADY_EXISTS = 183&           '* Cannot create a file when that file already exists
Private Const ERROR_INVALID_NAME = 123&             '* The filename, directory name, or volume label syntax is incorrect
Private Const ERROR_CANCELLED = 1223&               ' The operation was canceled by the user

Function lWinAPI_MkDir(sPath As String) As Long
     lWinAPI_MkDir = SHCreateDirectoryEx(0&, sPath, ByVal 0&)
End Function

' а книгу как создать?
' например
Sub MkSheetWB()
     Dim sPath As String
     sPath = "C:\Fold1\Fold2\Fold3\"
      
     ' создаем папку
     lWinAPI_MkDir sPath   ' одной строкой!
      
     Dim sName As String
     sName = ActiveSheet.Name
      
     sPath = sPath & sName & ".xls"

     ActiveSheet.Copy
     ActiveWorkbook.SaveAs Filename:=sPath, FileFormat:=xlExcel8
     ActiveWorkbook.Close
End Sub

Public Sub www1()
      CreateObject("Shell.Application").Namespace("h:\").NewFolder ("New Folder\New Folder\New Folder")
End Sub

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

Public Sub www()
     MakeSureDirectoryPathExists "C:\Fold1\Fold2\Fold3\"
End Sub

CreateObject("Shell.Application").Namespace(ThisWorkbook.Path).NewFolder (TextBox1)

Dim wb As Workbook
Set wb = Workbooks.Add
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & TextBox1 & "\" & TextBox3 & ".xlsx"
wb.Close

Sheets("Копируемый лист").Copy
SaveAs Filename:=ThisWorkbook.Path & "\" & TextBox1 & "\" & TextBox3 & ".xlsx", CreateBackup:=False
ActiveWorkbook.Close

CreateObject("Shell.Application").Namespace(ThisWorkbook.Path).NewFolder (TextBox1)
Dim wb As Workbook
Set wb = Workbooks.Add
     With ThisWorkbook.Sheets("Лист2")
         .Copy wb.Sheets(1)
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & TextBox1 & "\" & TextBox3 & ".xlsx"
  End With
wb.Close