Может кому-то поможет!
Формулировка задачи.
Создать структуру именных папок с принадлежностью по отделам. Данные представлены в виде таблицы (файл .xls)
Пример таблицы
Фамилия И.О. Отдел
Иванов Н.В. ХИМЦЕХ
Сидоров Т.А. ХИМЦЕХ
Петров Е.Н. ЦОТО
Кукушкин Н.Е. ЦОТО
Пакович А.В. ЦТП
Храма Л.А. ЦТП
Аветава Ф.И. ЭЛЕКТРОЦЕХ
Артышок С.В. ЭЛЕКТРОЦЕХ
Код программы
Sub Papki_sozdat()
'счетчик строк
Dim i, j As Integer
'имя именной папки (берется из столбца А Листа4)
Dim Papki_N As String
'имя папки "отдела" (берется из столбца В Листа4)
'в ней располагаются именные папки
Dim Otdel As String
'устанавливаем первоначальные "параметры"
j = 2
i = 2
Otdel = Лист4.Cells(j, 2).Value
MkDir "АТЦ"
ChDir "АТЦ"
'пока ячейка в столбце "Отдел" не станет пустой выполняй
While Лист4.Cells(j, 2).Value <> ""
'если Otdel не равен содержимому ячейки тогда
If Otdel <> (Лист4.Cells(j, 2).Value) Then
'подняться на один уровень вверх
ChDir ".."
'присвоить Otdel содержимое ячейки
Otdel = Лист4.Cells(j, 2).Value
'создаем папку
MkDir Otdel
'открываем вновь созданную папку (Otdel)
ChDir Otdel
'иначе
Else
'присвоить Papki_N содержимое ячейки
Papki_N = Лист4.Cells(i, 1).Value
'создаем папку
MsgBox Papki_N
'открываем вновь созданную папку
MkDir Papki_N
j = j + 1
i = i + 1
'конец условия
End If
'конец цикла
Wend
'конец программы
End Sub