Создание папок и подпапок с помощью макроса VBA

Question

Я хочу использовать электронную таблицу, которую я создал, для создания папок и подпапок на основе содержимого каждого столбца.

Первый столбец - это верхний уровень, второй столбец - следующий уровень вниз (подпапка) и т.д.

    A                 B                   C                   D
1   TOP FOLDER 1      Sub Folder 1.1      Sub Folder 1.2      Sub Folder 1.3
2   TOP FOLDER 2      Sub Folder 2.1      Sub Folder 2.2      Sub Folder 2.3
3   TOP FOLDER 3      Sub Folder 3.1      Sub Folder 3.2      Sub Folder 3.3

Я уже пробовал другую программу, и она создала папки, но поместила их все в одну папку! Мне нужно это с подпапками, но я думаю, что проблема может быть в разделении папок, вот пример:

Я думаю, что это может быть проблематично разделить подпапки на родительские папки, потому что они находятся в тех же столбцах ...

Answer 1

Это создает структуру папок с VBA. Коротко и красиво.

Sub CreateFolderStructure()
    Dim objRow as Range, objCell as Range, strFolders as String

    For Each objRow In ActiveSheet.UsedRange.Rows
        strFolders = "C:\myRootFolder"            
        For Each objCell In objRow.Cells
            strFolders = strFolders & "\" & objCell
        Next            
        Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))
    Next    
End Sub

^{Нет обработки ошибок!}

Что оно делает

1. Прокрутите каждую использованную строку вашего активного листа Excel
2. Установите корневую папку, в которой должны быть созданы наши новые папки. Должно быть сделано в каждом цикле
3. Перебрать все используемые ячейки в текущей строке
4. Объедините корневую папку с обратной косой чертой и новой подпапкой.
   Делайте это для каждой подпапки в этой строке, пока мы не получим что-то вроде
   "C:\myRootFolder\TOP FOLDER 1\SUB FOLDER 1.1\SUB FOLDER 1.2\SUB FOLDER 1.3"
5. Теперь приходит магия. Мы не используем функцию VBA mkdir .
   Вместо этого мы используем Shell(cmd /c md) который может создать несколько папок одной командой. Это также не выдает ошибку, если папка уже существует. Такая красивая команда

Некоторые заметки

• Избегайте следующих символов в именах папок: © ® " - & ' ^ ( ) @
• Пустые ячейки Excel не проблема. Команда MD может обрабатывать строки, такие как C:\root\\subfolder с двумя последовательными обратными слешами
• Пробелы в именах папок не являются проблемой, поскольку мы заключаем всю структуру в две кавычки ( chr(34) )

Answer 2

Вот лучший ответ, который позволяет вам выбрать корневой файл вместо определения его в коде:

Sub FolderCreator()

    Dim objRow As Range, objCell As Range, strFolders As String, rootFolder As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        ' show the file picker dialog box
        If .Show <> 0 Then
            rootFolder = .SelectedItems(1)
              End If
    End With

    For Each objRow In ActiveSheet.UsedRange.Rows
        strFolders = rootFolder
        For Each objCell In objRow.Cells
            strFolders = strFolders & "\" & objCell
        Next
        Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))
    Next

End Sub

Answer 3

Sub MkDirs()

    Const RootPath = "C:\your\path"
    Dim rng As Range

    Set rng = Selection

    For Each rw In rng.Rows
        ChDir RootPath
        For Each cl In rw.Cells
            If cl <> "" Then
                MkDir cl
                ChDir cl
            End If
        Next
    Next 
End Sub