Создание папок VBA Exсel

[Hugo121]

Игорь - лишний явно п.3

А по задаче - мой код именно так и делает. Всего делов - открыть каждый день вот прямо первым делом прямо с утра этот график, а в нём на воркбоок.опен задать выполнение кода.

[IgorGO]

Игорь, браво!!!
я не сомневался!)))


Катя,
вернемся к Вашей задаче.
не можете исправить почти работающий код - потрудитесь скурпулезно описать задачу, у кого-то будет время и настроение - напишут Вам код под Вашу задачу

а пока нет четкой задачи - не будет и решения, ну разве что, кого-то осенит и он угадает как все должно работать.

[Hugo121]

Ну насколько я помню из первой темы - там в строке поиск не находил сегодняшнюю дату. Что не удивительно - по картинке то...

[Екатерина Попкова]

По данному примеру,который ниже,Вы можете подредактировать его исходя из моей задаче (которую я писала)?

Вот код который необходимо подредактировать:
Sub tt()
Const ROOT = "d:\" 'заменить на свой путь
Dim c, strDate$
strDate = Format(Now, "dd.mm.yyyy" & "г.")
Set c = [b2:af2].Find(Day(Now))
For Each c In Range(Cells(3, c.Column), Cells(Rows.Count, c.Column).End(xlUp)).Cells
If c.Row > 2 Then
If Val(c.Value) > 0 Then
On Error Resume Next
MkDir ROOT & strDate & "\"
MkDir ROOT & strDate & "\" & Cells(c.Row, 1).Value & "\"
End If
End If
Next
End Sub


Вот моя задача:
Необходимо создать папки с именами сотрудников,исходя из графика xls (график прилагала).Т.е.на рабочем столе создать папку с именем даты,и в этой папке должны быть папки,с именами сотрудников (уже писала ранее)Как еще подробнее описать задачу..не знаю?


Ниже должн быть уже исправленный листинг, исходя из моей задаче

[IgorGO]

поместите этот

Private Sub Workbook_Open()
  Dim pth As String, strDate$, r As Long, c As Long
  pth = DeskTopPath & Application.PathSeparator & Format(Now, "dd.mm.yyyy" & "г")
  If Dir(pth, vbDirectory) = "" Then MkDir pth Else Exit Sub
  pth = pth & Application.PathSeparator
  With Worksheets("График")
    On Error Resume Next:  c = .[b2:af2].Find(Day(Now)).Row
    For r = 3 To Cells(Rows.Count, c).End(xlUp).Row
      If Not IsEmpty(.Cells(r, c)) Then MkDir pth & .Cells(r, 1).Value
    Next
  End With
End Sub



Function DeskTopPath() As String
  DeskTopPath = Environ("HOMEDRIVE") & Environ("HOMEPATH") & Application.PathSeparator _
  & CreateObject("WScript.Shell").RegRead("HKCU\Software\Microsoft\Office\" & _
  Application.Version & "\Common\General\DeskTop") & Application.PathSeparator
End Function

в модуль книги. сохраните, закройте файл, откройте файл.

[Екатерина Попкова]

Код заработал))огромное спасибо!!!(напишите номер вашей карточки,хоть что то вам перечислю)
Но есть нюансы:
1.В графике на 20 апреля некто не отмечен,по сути он должен создать пустую папку с наименованием 20.04.2015.Но на деле он создал папку с именен 20.04.2015г. с папками:Есупова М.Н.,Иванов И.И.,Кузнецов А.М.-как это он там наобум взял имено эти фамилии..?
2.Если поменять у себя на компьютере дату,к примеру на завтра,на 21.04.2015г.он должен создать новую папку с именен 21.04.2015г.?В данном случае у меня это не прокатывает

[IgorGO]

не можете исправить почти работающий код - потрудитесь скурпулезно описать задачу, у кого-то будет время и настроение - напишут Вам код под Вашу задачу

1. откуда мне знать, что катит, что не катит,
2. откуда мне знать как часто меняется дата на Вашем компьютере? и как это влияет на выполнение задачи?
3. откуда мне знать что там находиться в ячейках? (я вижу только картинку листа, но не знаю что там в ячейках, возможно там формула, которая ставит 1 или "", а я проверяю ячеку на условие Если ячейка не пуста под данным числом, то сделать папку с соотв. фамилией)
ОТКУДА мне все это знать, когда задача не описана!

сейчас все работает на таком алгоритме:
1. макрос срабатывает при каждом открытии файла
2. проверяет есть ли на рабочем столе папка с имнем СЕГОДНЯ в формате ДД.ММ.ГГГГг
3. если такая папка есть - дальше не происходит ничего (ибо значит, что сегодня файл уже открывался и все необходимое сделано см.п.4)
4. если папки нет
4.1. создается папка по формату п.2
4.2. во второй строке листа График находится День, соотв. сегодня
4.3. в колонке под днем проверяется содержимое ячеек. если ячейка не пуста - в папке "сегодня" создается папка с именем, содержащимся в 1-й ячейке проверяемой строки

как-то так
а что нужно Вам, знаете пока только Вы.

[Hugo121]

Если заработал этот код - то вроде как нет причин не работать и тому давнему моему...
Ну разве что не винда... Или может на х64 не заработало? В остальном механизм ведь не менялся.

[IgorGO]

допустим, Д: это ДиВиДи-привод, и в нем нет болванки...
и все.. код не работает)))

[Hugo121]

Ну так там ведь человеческим языком написано: 'заменить на свой путь