Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
создание папок макросом
 
#1
29.07.2015 10:13:59
Добрий день!

Нужна помощь в написании макроса
1. нужно макросом проверить наличие по пути D:\work\ARCH\IN\ папки yyyy(год, например 2015), если нет такой папки то создать, затем в папке yyyy проверить наличие папки mm.yy(номер месяца.год, например , 07.15) если нет такой папки то создать, затем в папке mm.yy создать папки, например папка 1, папка 2, папка 3
в результате должно получится например,  D:\work\ARCH\IN\2015\07.15\папка 1

2. нужно макросом проверить для каждой папки например, папка 1, папка 2, папка 3(ети папки находятся  по пути D:\temp\OD\обработание файли\Отчети\ ) наличие
папки yyyy(год, например 2015), если нет такой папки то создать, затем
проверить в папке yyyy наличие папки mm(номер месяца например , 07) если нет такой папки то создать
в результате должно получится например, D:\temp\OD\обработание файли\Отчети\папка 1\2015\07
Изменено: sergey2303 - 29.07.2015 10:37:07
 
 
 
#2
29.07.2015 10:37:02
Можно одной строкой кода создать все нужные подпапки:
http://excelvba.ru/code/MkDir
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#3
29.07.2015 11:16:24
а можно готовий макрос
 
 
 
#4
29.07.2015 12:46:11
код для задания 1. Может быть по аналогии сделаете задание 2
посмотрите комментарии в коде
код
Изменено: Karataev - 29.07.2015 12:54:58
 
 
 
#5
29.07.2015 13:05:43
Под виндой проще так (пример какой был, не под задачу):
Код
?
1
2
3
4
5
6
7
8
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Sub bb()
    Const ROOT = "d:\"
    Dim c
    For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp)).Cells
         MakeSureDirectoryPathExists ROOT & c & "\"
    Next
End Sub
Хотя смотрю выше Игорь уже показал анологичное на
Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" _
                                    (ByVal hwnd As Long, ByVal pszPath As String, _
                                     ByVal psa As Any) As Long
Изменено: Hugo - 29.07.2015 13:08:44
 
 
 
#6
29.07.2015 14:27:10
Karataev
1. как сработает макрос при запуске в августе, нужно править переменние    ?
Код
?
1
2
    strYear = "2015"
    strMonth = "07.15"
2. я извеняюсь что неправильно написал "затем в папке mm.yy создать папки, например папка 1, папка 2, папка 3", нужно создать папки с разними именами
 
 
 
#7
29.07.2015 14:40:11
Цитата
sergey2303 написал: 1. как сработает макрос при запуске в августе, нужно править переменние    ?
да, в переменную strMonth нужно так записать:
strMonth = "08.15"
Цитата
sergey2303 написал: 2. я извеняюсь что неправильно написал "затем в папке mm.yy создать папки, например папка 1, папка 2, папка 3", нужно создать папки с разними именами
по аналогии используйте оператор MkDir. Оператор MkDir создает папку: указываете путь и имя папки и создается папка
Изменено: Karataev - 29.07.2015 15:02:59
 
 
 
#8
29.07.2015 14:48:30
а можно без записи в переменную, что би каждий месяц не лазить в макрос и
Цитата
Karataev написал:
по аналогии используйте оператор MkDir. Оператор MkDir создает папку: указываете путь и имя папки и создается папка
можете пример для одной папки
 
 
 
#9
29.07.2015 14:53:22
sergey2303, можно, если объясните макросу (или нам) откуда брать год и месяц.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#10
29.07.2015 14:53:47
Цитата
sergey2303 написал: а можно без записи в переменную, что би каждий месяц не лазить в макрос
этот код работает с текущим годом и месяцем -в коде не нужно теперь писать год и месяц
код

Цитата
sergey2303 написал: можете пример для одной папки
посмотрите комментарий в коде
код
Изменено: Karataev - 29.07.2015 15:56:09 (изменен код)
 
 
 
#11
29.07.2015 15:50:43
Karataev, а можете сделать макрос для второго пункта.
сдесь тоже папки разние
 
 
 
#12
29.07.2015 15:55:21
код
 
 
 
#13
29.07.2015 16:27:37
Альтернативный вариант ;)
Великий и могучий  FileSystemObject в помощь
Рабочая функция создания папок, с примером использования
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub Primer()
Dim sPath
sPath = CreatePath("D:\work\ARCH\IN\2015\07.15\папка 1")
If sPath Then MsgBox "папка создана", vbInformation
End Sub
 
Function CreatePath(PathName) As Boolean
  ' Формирование папки с указанным именем.
  ' Имя папки должно быть полным и начинаться с имени драйвера (диска или сетевого сервера).
  ' Функция создает указанную папку с любым уровнем вложения папок _
    (в отличие от стандраного средтва объекта FileSystemObject, который создает только концевую папку).
  ' Возвращает True если папка уже существует или если она успешно создана.
Dim FSO, cDrive$, cFolder$, aFolders, nFolder, pSp
   Set FSO = CreateObject("Scripting.FileSystemObject")
   pSp = Application.PathSeparator
  If FSO.FolderExists(PathName) Then
    CreatePath = True
    Exit Function
  End If
  cDrive = FSO.GetDriveName(PathName)
  cFolder = Mid$(PathName, Len(cDrive) + 2)
  If Right$(cFolder, 1) = pSp Then cFolder = Left$(cFolder, Len(cFolder) - 1)
  If Left$(cFolder, 1) = pSp Then cFolder = Mid$(cFolder, 2)
  aFolders = Split(cFolder, pSp, -1, 0)
  cFolder = cDrive & pSp
  If Not FSO.FolderExists(cFolder) Then
    On Error GoTo Break
    FSO.CreateFolder cFolder
  End If
  If Not IsEmpty(aFolders) Then
    For nFolder = 0 To UBound(aFolders)
      cFolder = cFolder & aFolders(nFolder) & pSp
      If Not FSO.FolderExists(cFolder) Then
        On Error GoTo Break
        FSO.CreateFolder cFolder
      End If
    Next
  End If
  If Not FSO.FolderExists(cFolder) Then GoTo Break
  CreatePath = True
  Set FSO = Nothing
  Exit Function
 
Break:
  If MsgBox(Err.Description, vbExclamation + vbOKCancel, _
      "clsFSO.CreatePath") = vbCancel Then Stop
End Function
 
 
 
#14
29.07.2015 17:03:56
всем большое спасибо. все работает
 
 
 
Страницы: 1
Читают тему
Наверх
Loading...