Страницы: 1
RSS
VBA: Применить макрос ко всем* книгам в папке
 
Добрый день!
В поиске есть похожие решения? но немного не то. Поэтому решил спросить отдельно.
Нужно применить макрос ко всем книгам в папке, кроме одной, имя которой можно получить макросом.
Есть следующее: Папка в экселевскими файлами. Макрос создает файл в этой папке, в который записываются результаты обработки файлов содержащихся в папке (через диалог). Путь к папке известен, имя файла-исключения известно. Нужно применить макрос ко всем файлам, кроме созданного и известного файла. Осложняется тем? что могу быть открыты и другие книги, из других папок.
Нужен какой-то метод который сможет перебрать все файлы по условию.
Помогите, плиз.
Изменено: jfd - 01.04.2013 01:07:26
 
если Вы макрос проходит в цикле по файлам из конкретной папки, то "другие книги из других папок" никоим образом не помешают ему.
Изменено: ber$erk - 27.03.2013 13:12:16
Учимся сами и помогаем другим...
 
Добрый день.

Предлагаю создать отдельный лист, в который выгрузить список всех файлов из необходимой папки. В соседнюю ячейку внести формулу  "если" для получения списка без "ненужный" файлов. Запустить  макрос с последовательной обработкой файлов по именам из "обработанных ячеек".

Извлечение списка приложил.
Второй макрос, сами писали, что
Цитата
jfd пишет:
В поиске есть похожие решения
 
Нет необходимости создавать лист и формулы - ber$erk прав: будут обработаны только файлы из выбранной папки. Добавить в цикле проверку на имена: файла с макросом и создаваемого файла.
 
Юрий М, я понимаю что это надо сделать   :)  , но не знаю чем
 
Я полагал, что вариант перебора файлов Вы УЖЕ нашли.
Цитата
В поиске есть похожие решения
В поиск: перебрать файлы в папке.
 
не пинайте сильно, не могу разобраться почему в одном случае работает? а в другом нет
работает:
Код
Sub Get_All_File_from_Folder()
    Dim sFolder As String, sFiles As String
   ' With Application.FileDialog(msoFileDialogFolderPicker)
   '     If .Show = False Then Exit Sub
   '     sFolder = .SelectedItems(1)
   ' End With
    sFolder = "D:\Excell\1"
    'sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "\*.xls")
    Do While sFiles <> ""
        'открываем книгу
        Workbooks.Open sFolder & sFiles

sFiles равно файлу с нужным расширением

не работает:
Код
Sub Реестр()
Dim visitTime, dateVisit As Date
Dim kontrName, kontrAdr, sotrIndex, FolderPath, sFiles As String


Set regWb = Excel.Workbooks.Add()
ActiveWorkbook.Application.Dialogs(xlDialogSaveAs).Show
FolderPath = CStr(ActiveWorkbook.Path)
Filename = ActiveWorkbook.Name
MsgBox FolderPath
ActiveWindow.ActivatePrevious
           
    'FolderPath = FolderPath & IIf(Right(FolderPath, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = True
    sFiles = Dir(FolderPath & "\*.xls")
    Do While sFiles <> ""

sFiles равно имени книги которая была создана этим макросом (переменная FileName)
Изменено: jfd - 27.03.2013 17:45:43
 
Получение списка файлов из папки:
http://excelvba.ru/code/FilenamesCollection

Обработка всех файлов в папке:
http://excelvba.ru/code/CombineFiles
 
EducatedFool, спасибо. разумеется это видел. нужна не рыба, нужна удочка  :D
 
Цитата
нужна не рыба, нужна удочка
странные вы люди)

по второй ссылке, в прикреплённом файле, - готовое решение, где надо изменить всего одну строку кода
(заменить вставку данных на лист Excel на вызов вашего макроса)

а удочек у меня нет)
 
Оба кода выложены неполностью и что именно не работает не указано.
Путь переменной FolderPath задан неверно - отсутствует слеш. Значит открытие книги завершится с ошибкой, говорящей об отсутствии файла(кстати, Вам это виднее должно быть - ошибка у Вас появляется).
Код
FolderPath = ActiveWorkbook.Path & "\"

следовательно
Код
sFiles = Dir(FolderPath & "*.xls")

Если хотите сверять текущий файл с активной книгой, то надо добавить условие:
Код
Do While sFiles <> ""
If Filename <> sFiles then
workbooks.Open  FolderPath & sFiles
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist, постараюсь не превратить обсуждение в то, что написано в вашей подписи.
первый случай работоспособен, я не стал весь код приводить чтобы не занимать место, да и остаток не важен. По F8 мы доходим до главного - присвоения переменой sFiles имени файла из папки с заданной маской. Оно присваивается правильно.
Во втором случае проблема в том что sFiles = Dir(FolderPath & "*.xls") не воспринимает фильтр по маске.
А если написать так sFiles = Dir(FolderPath), то все ОК. начинается перебор всех файлов в папке. Но мне надо перебор не всех, а по маске.
 
Я же написал - СЛЕШ на законное место верните. Сравните два кода и посмотрите какое у Вас в результате имя у файла для открытия получается, если слеш не указать.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist, я по всякому пробовал. в итоге пришлось извратиться вот так
Код
Sub Реестр()
Dim visitTime, dateVisit As Date
Dim kontrName, kontrAdr, sotrIndex, FolderPath, sFiles As String

FolderPath = ThisWorkbook.Path & "\"
regWb = ThisWorkbook.Name

    Application.ScreenUpdating = False
    sFiles = Dir(FolderPath)
    Do While sFiles <> "" And sFiles <> "реестр фото.xlsm"

макрос записать в файл реестр фото и положить его в папку с файлами к которым нужно применить макрос. т.е. "реестр фото.xlsm" и есть тот файл исключение, который не надо обрабатывать. в него же и собираются данные с остальных файлов в этой папке.
Изменено: jfd - 27.03.2013 22:25:29
 
Да? Ну вот почему я пробую - у меня работает, если слеш поставить.
Давайте теперь будем посимвольно:
Код
FolderPath = CStr(ActiveWorkbook.Path)

допустим книга в папке "Папка1" на диске С. Какую строку вернет ActiveWorkbook.Path? Верно: "C:\Папка1". Слеша НЕТ.
Код
FolderPath & "\*.xls"

здесь Вы его добавляете вручную. Т.е. получается "C:\Папка1\*.xls" и мы просматриваем в Папка1 файлы .xls. Все верно. Первым пусть будет Файл1.xls.
Код
Workbooks.Open FolderPath & sFiles

Но что тогда будет здесь? Верно: Workbooks.Open "C:\Папка1Файл1.xls".
Т.е. код будет пытаться открыть в корне диска С файл, который по сути расположен в Папка1, и название которого - "Папка1Файл1.xls".

Теперь понятнее зачем нужен более полный код? И в чем может быть ошибка там, где Вы нам её не хотите показывать?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist, я приложу архив с папкой путь к которой я использовал и полный код макроса. посмотрите что присваивается sFile в 13 строке. у меня "бяка.xlsm"
Изменено: jfd - 27.03.2013 22:53:46
 
Меняем
Код
sFiles = Dir(FolderPath & "*.xls")

на
Код
sFiles = Dir(FolderPath & "*.xls*")
 
Sergei_A, мне нужны только файлы с расширением .xls иначе для меня это все равно что не указывавать маску
 
Вот что...У Вас проблема в том, что не только xls, но и остальные Excel файлы попадают. Сделайте проверку:
Код
If right(sFiles,4) = ".xls" then
'обрабатываем
end if

Так проще и надежнее всего будет.

Если не угадал опять - опишите уже нормально, что именно в коде не устраивает.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist, в принципе да, можно и так (If right(sFiles,4) = ".xls" then) по маске выбрать нудные файлы.
поставленная задача решилась, спасибо за помощь. просто хотелось бы понять, почему у меня не работала маска  в
sFiles = Dir(FolderPath & "*.xls") или как могло бы sFiles = Dir(FolderPath & "???_???_*.xls")
 
:D
http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=8&TID=28653&MID=250752#message250752
Страницы: 1
Наверх