Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос создания папки и подпапок
 
#1
30.05.2017 08:49:29
Добрый день, уважаемые!

Такая вот задачка: нужно прописать макрос, который в определенной папке, путь которой можно менять вручную, создавать другую папку с названием месяца. Если такая папка уже имеется пропускать этот шаг и ...
С созданием папок с условиями вообще не знаю((( Получается что-то ужасное...

Помогите, пожалуйста. Буду премного благодарна!!
Файл-пример во вложении...
 
 
 
#2
30.05.2017 09:30:44
как пример создания файла и папки http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=88559&amp...
Инженер не тот, кто все знает, а тот кто знает где найти ответ.
 
 
 
#3
30.05.2017 09:42:46
Irbis_evs,

:) Вот этот макрос и хочу изменить но не получается... Где именно в макросе этом строка создания папки и переименовывания ее? Далее вижу некоторые условия, кажется то, что мне нужно, но и там то же самое-сама формула создания папки. Потому как мне не по году или месяцу нужно, хочу переделать...
Для папки так?
Код
Sub Main()
     
    Const strRootFolder As String = "M:\Production\Мастера\2017\Нормализация"
     
    strYear = "имя_папки"

    If Dir(strRootFolder & strYear, vbDirectory) = "" Then
        MkDir strRootFolder & strYear
    End If
     
    If Dir(strRootFolder & strYear & "\" & strMonth, vbDirectory) = "" Then
        MkDir strRootFolder & strYear & "\" & strMonth
    End If
     
End Sub

Спасибо!
Изменено: Honey - 30.05.2017 09:46:00 (добавление кода)
 
 
 
#4
30.05.2017 10:25:28
Это и есть проверка на наличие и создание, первое If каталог по ГОДУ, второе по месяцу.
у меня почему то не проходит команда MkDir.
и для ознакомления http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=8&TID=18214&amp...
Инженер не тот, кто все знает, а тот кто знает где найти ответ.
 
 
 
#5
30.05.2017 10:30:34
Изучайте FileSystemObject.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#6
30.05.2017 10:35:55
JayBhagavan, полезная ссылка. В закладки.
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.
 
 
 
#7
30.05.2017 10:59:19
Код
Sub Main()     
    Const strRootFolder As String = "M:\Production\Мастера\2017\Нормализация"
    
    Dim strYear As String    
    strYear = "M:\Production\Мастера\2017\Нормализация\имя_папки"
    
    If Dir(strYear, vbDirectory) = "" Then
        MkDir strYear
    End If
End Sub

Папка создается теперь. Только она так и создается как имя папки. А это по идее у меня название диапазона, откуда нужно брать правильное значение для имени папки. Пробовала как Range, но снова что-то не то...
 
 
 
#8
30.05.2017 11:02:04
JayBhagavan,
Спасибо!
Пошла изучать...)))
 
 
 
#9
30.05.2017 11:14:23
Так?
Код
     
    Const strRootFolder As String = "M:\Production\Мастера\2017\Нормализация"
     
    Dim strYear As String    
    strYear = "M:\Production\Мастера\2017\Нормализация\" & Range("A1").Value
Только замените "A1" на нужный адрес.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#10
30.05.2017 11:18:58
JayBhagavan,
Код
Sub Main()
     
    Const strRootFolder As String = "M:\Production\Ìàñòåðà\2017\Íîðìàëèçàöèÿ"
    
    Dim strYear As String
    
    strYear = "M:\Production\Ìàñòåðà\2017\Íîðìàëèçàöèÿ\" & "Range("O3").Value
    
    If Dir(strYear, vbDirectory) = "" Then
        MkDir strYear
    End If
  
   
End Sub


O3  это и есть имя_папки (я так и назвала, чтоб самой понятно было). Но теперь ошибку выдает: ошибка синтаксиса и выделяет эту самую строку...
Изменено: Honey - 30.05.2017 11:20:07
 
 
 
#11
30.05.2017 11:21:22
JayBhagavan,
Ой все! Я сама с ошибкой написала, не доглядела Вашу формулу. Спасибо большое!!!
Теперь буду пробовать создать уже в этой папке книгу)))
 
 
 
#12
30.05.2017 11:31:29
Honey, насчёт ошибки, уберите перед Range("O3").Value лишнюю двойную кавычку. Пожалуйста. Успеха Вам. :)

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#13
30.05.2017 12:04:21
Вариант, в общий модуль:
Код
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Sub Main()
    MakeSureDirectoryPathExists "m:\Production\Мастера\2017\Нормализация\имя_папки" & [O3].Value & "\"
End Sub

Или так:
Код
Public Sub MakeSubfolders()
    CreateObject("Shell.Application").Namespace("m:\").NewFolder "Production\Мастера\2017\Нормализация\имя_папки" & [O3].Value
End Sub
Я сам - дурнее всякого примера! ...
 
 
 
#14
30.05.2017 12:11:53
kuklp, спасибо :)
 
 
 
#15
30.05.2017 12:43:02
Или ещё можно использовать SHCreateDirectoryEx
Подробнее тут
 
 
 
#16
30.05.2017 12:43:02
Всем большое спасибо за ответы!
 
 
 
Страницы: 1
Наверх