Sub CreateFolderFromCel5()

    Dim folderPath As String
    Dim cellValue As String
    
    ' Получаем значение из ячейки B4
     cellValue = ThisWorkbook.ActiveSheet.Range("B4").Value
    
    ' Проверяем, что ячейка не пустая
    'If Trim(cellValue) = "" Then
        'MsgBox "Ячейка пустая!", vbExclamation
        'Exit Sub
    'End If
    
    ' Формируем полный путь (например, на рабочем столе)
    folderPath = "D:\L???\???\???\???\???\??????\" & cellValue & "\"
    
    ' Создаем папку
    If MakeSureDirectoryPathExists(folderPath) Then
        MsgBox "Папка успешно создана: " & folderPath, vbInformation
    Else
        MsgBox "Ошибка при создании папки", vbCritical
    End If
    
End Sub

Sub CreateFolderFromCel3()

    Dim folderPath As String
    Dim cellValue As String
    
    ' Получаем значение из ячейки B4
    cellValue = ThisWorkbook.Range("B4").Value
    
    ' Проверяем, что ячейка не пустая
    If Trim(cellValue) = "" Then
        MsgBox "Ячейка пустая!", vbExclamation
        Exit Sub
    End If
    
    ' Формируем полный путь (например, на рабочем столе)
    folderPath = Environ("USERPROFILE") & "\Desktop\" & cellValue & "\"
    
    ' Создаем папку
    If MakeSureDirectoryPathExists(folderPath) Then
        MsgBox "Папка успешно создана: " & folderPath, vbInformation
    Else
        MsgBox "Ошибка при создании папки", vbCritical
    End If
    
End Sub

Sub CreateFolderInCurrentDirectory12()

    Dim folderName As String
    Dim fullPath As String
    
    ' Получаем имя папки из активной ячейки
    folderName = ActiveCell.Value
    
    ' Проверка на пустое значение
    If Trim(folderName) = "" Then
        MsgBox "Выделите ячейку с именем папки", vbExclamation
        Exit Sub
    End If
    
    ' Удаляем недопустимые символы в имени папки
    folderName = CleanFileName(folderName)
    
    ' Создаем путь в той же папке, где находится файл Excel
    fullPath = ThisWorkbook.path & "\" & folderName
    
    ' Проверяем, существует ли уже такая папка
    If Dir(fullPath, vbDirectory) = "" Then
        MkDir fullPath
        MsgBox "Папка создана: " & fullPath, vbInformation
    Else
        MsgBox "Папка уже существует!", vbExclamation
    End If
    
End Sub

Sub CreateFolderFromCell()
    Dim folderName As String
    
    ' Получаем значение из активной ячейки A1 текущего листа
    folderName = ActiveSheet.Range("A1").Value

    If Len(folderName) > 0 Then
        On Error Resume Next
        
        ' Пробуем создать папку с данным именем
        MkDir ThisWorkbook.Path & "\" & folderName
        
        If Err.Number <> 0 Then
            MsgBox "Ошибка при создании папки: " & Err.Description
        Else
            MsgBox "Папка успешно создана!"
        End If
    Else
        MsgBox "Название папки не введено."
    End If
End Sub