Просмотреть все файлы в папке
Иногда необходимо проделать однотипные операции с несколькими файлами, расположенными в одной папке. Можно открывать каждый по очереди:
Workbooks.Open "C:\Новая папка\Книга2.xlsx"
и т.д.
Но если файлов много и все с разными именами, то это не очень практично и совсем лишено гибкости. При помощи Visual Basic for Application можно решить проблему. При этом файлы можно просматривать как в одной папке, так и включая вложенные "подпапки".
Ниже приведен код, который перебирает все файлы в папке, открывает их и на первом листе каждого файла записывает текст
Sub Get_All_File_from_Folder() Dim sFolder As String, sFiles As String Dim wb As Workbook 'диалог запроса выбора папки с файлами With Application.FileDialog(msoFileDialogFolderPicker) If .Show = False Then Exit Sub sFolder = .SelectedItems(1) End With sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator) 'отключаем обновление экрана, чтобы наши действия не мелькали Application.ScreenUpdating = False sFiles = Dir(sFolder & "*.xls*") Do While sFiles <> "" 'открываем книгу Set wb = Application.Workbooks.Open(sFolder & sFiles) 'действия с файлом 'Запишем на первый лист книги в ячейку А1 - www.excel-vba.ru wb.Sheets(1).Range("A1").Value = "www.excel-vba.ru" 'Закрываем книгу с сохранением изменений wb.Close True 'если поставить False - книга будет закрыта без сохранения sFiles = Dir Loop 'возвращаем ранее отключенное обновление экрана Application.ScreenUpdating = True End Sub |
Если хотите перебрать файлы других форматов, а не Excel, то просто замените "*.xls" на нужное расширение. Например "*.doc". Также, если хотите собрать только файлы с определенными символами/словами в имени, то можно указать так:
В коде выше есть одна проблема: что если необходимо открыть файлы не только в указанной папке, но и во всех её подпапках? В версиях Excel 2003 и младше это решалось с помощью метода
Для этого используется встроенная в офис библиотека
Option Explicit Dim objFSO As Object, objFolder As Object, objFile As Object Sub Get_All_File_from_SubFolders() Dim sFolder As String With Application.FileDialog(msoFileDialogFolderPicker) If .Show = False Then Exit Sub sFolder = .SelectedItems(1) End With sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator) Application.ScreenUpdating = False Set objFSO = CreateObject("Scripting.FileSystemObject") GetSubFolders sFolder Set objFolder = Nothing Set objFSO = Nothing Application.ScreenUpdating = True End Sub Private Sub GetSubFolders(sPath) Dim sPathSeparator As String, sObjName As String Dim wb As Workbook Set objFolder = objFSO.GetFolder(sPath) For Each objFile In objFolder.Files If Replace(objFile.Name, objFSO.GetBaseName(objFile), "") Like ".xls*" Then 'открываем книгу Set wb = Application.Workbooks.Open(sPath & objFile.Name) 'действия с файлом 'Запишем на первый лист книги в ячейку А1 - www.excel-vba.ru wb.Sheets(1).Range("A1").Value = "www.excel-vba.ru" wb.Close True 'wb.Close False '- если в коде надо будет закрывать книгу без сохранения End If Next For Each objFolder In objFolder.SubFolders GetSubFolders objFolder.Path & Application.PathSeparator Next End Sub |
Код делает тоже самое, что и первый, но открывает и изменяет ячейку
If Replace(objFile.Name, objFSO.GetBaseName(objFile), "") Like ".xls*" Then |
Строка отвечает за тип перебираемых файлов. В примере будут просмотрены любые файлы Excel. Звездочка на конце означает любой символ или набор символов. Т.е. если указать без неё -
Если добавить условие:
то будут обработаны файлы, которые в имени содержат слово "книга". При этом регистр букв имеет значение. Т.е. если файл содержит в имени слово "Книга", то он не будет обработан.
Думаю теперь Вы легко сможете проделать необходимые операции с множеством файлов.
Все файлы в папке и подпапках.xls (62,5 KiB, 8 666 скачиваний)
В примере я закомментировал строки, открывающие файл и вносящие изменения в ячейку
В последнее время участились вопросы как просмотреть еще и все диски на ПК. Ниже выкладываю код, который просматривает все подключенные диски и просматривает все файлы во всех папках дисков:
Sub Get_All_drives() Dim objDrives As Object, objDrive As Object Set objFSO = CreateObject("Scripting.FileSystemObject") Set objDrives = objFSO.Drives For Each objDrive In objDrives If objDrive.IsReady Then GetSubFolders objDrive.DriveLetter & ":\" End If Next objDrive End Sub |
Для работы кода необходимо разместить его в том же модуле, что и код просмотра файлов в подпапках. Без него код просмотра дисков работать не будет, т.к. обращается к процедуре
Все файлы в папке и подпапках.xls (62,5 KiB, 8 666 скачиваний)
В примере код сканирует все диски и выводит в столбец А нового листа(лист создается автоматически) пути ко всем файлам.
Так же см.:
Как средствами VBA переименовать/переместить/скопировать файл
Как сменить формат сразу для нескольких файлов Excel
Как удалить папку или все файлы из папки через VBA
Собрать и просуммировать данные из разных файлов при помощи PowerQuery
Статья помогла? Поделись ссылкой с друзьями!
Видеоуроки
Поиск по меткам
Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистикаКомментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум
Дмитрий, Добрый час!
Подскажите, пожалуйста, как сделать, чтобы макрос сканировал определенную папку и выводил сообщение, если в папку загрузились файлы?
Никак. Это надо писать отдельный скрипт, который будет вести лог действий с папкой и то, в рамках VBA все по сути сведется к запуску кода через какие-то промежутки времени, потому что копирование файлов в папку это системное событие, к которому у VBA доступа нет.
Николай, большое спасибо. Долго думал как вместо диалогового окна зашить фиксированную ссылку. Всего то надо было посмотреть первые комментарии к разделу)
Просто заменил это:
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
sFolder = .SelectedItems(1)
End With
На это:
sFolder = "C:\Users\Shama\Desktop\Куча ненужный файлов"
Спасибо за код! Искал сначала на англоязычных сайтах - не нашел)
Не подскажете, с чем может быть связано, что при использовании второго макроса (с заходом в подпапки) файл откатывается к состоянию до последнего сохранения (даже изменения в коде теряются). Пошаговое использование показывает, что до рекурсии изменения в файл вносятся, но потом пропадают где-то перед завершением макроса. Если сохраняться и писать в другой файл, все работает, но как минимум интересно, где может быть загвоздка
Георгий, скорее всего проблема возникает из-за того, что файл с кодом находится в той же папке(или в одной из подпапок), которая просматривается кодом. В этом случае файл переоткрывается, теряя все несохраненные данные.
Поместите файл с кодом в совершенно другую папку или добавьте в коде проверку(перед строкой открытия файла):
Дмитрий, спасибо за макрос. Пытался применить данный код для открытия и применения различных действий над документами Ms Word. Но прочитав в книге:
Open() — еще один важнейший метод коллекции Documents. Позволяет открыть документ с диска и добавить его в коллекцию. Этот метод принимает множество параметров, из которых обязательным является только один — имя документа (вместе с путем к нему). Самый простой вариант применения этого метода выглядит так:
Dim oDoc1 As Document Set oDoc1 = Documents.Open("c:\doc1.doc")
приуныл.
Есть ли другой метод, позволяющий открыть документы без указания каталога и имени файла?
Сергей, не совсем понял, что в итоге вообще нужно. Нельзя открыть никакой документ, не зная его пути и имени.
Если же речь о конкретно кодах статьи, то вот Вам пример(непонятно, почему он не рассматривается Вами как рабочий):
Только непонятно откуда Вы этот код тогда вообще запускаете: из Ворда или Excel. подходы будут чуть разные.
Добрый день. Очень поможете, если подскажете, есть ли возможность перебирать все файлы pdf и оставить только открывающиеся, работающие. Приходится иногда перебирать целыми днями файлы объемом 50000 единиц, очень накладно
Виктор, к сожалению не подскажу. Потому что понять из VBA рабочий файл PDF или нет практически невозможно, т.к. это не формат офиса. В последних версиях хоть и есть подобная возможность, но и работает не со всеми форматами PDF, поэтому это весьма не надежный метод. Вам надо присмотреться к программам по обработке PDF - возможно где-то есть функционал, который позволяет обратиться из VBA к этому приложению и понять, открылся ли файл и отвечает ли он ожиданиям.
почему-то при пересохранении файлов из формата xls в xslx все числа учножаются на 1000 - т.е. был 1 стало 1000, был 0 - стал 0,000.
самое не понятное - если сохранять руками ничего такого не происходит
Алексей, проверьте в настройках: Файл -Параметры -Дополнительно. Параметр "Автоматическая вставка десятичной запятой". Возможно там установлено отрицательное число. Так же возможен вариант нахождения в файле макроса, который делает подобные преобразования.
Добрый день!
Пытаюсь пройтись по всем файлам и оставить ТОЛЬКО нужные строки.
Вот код:
Private Sub Test2()
Dim iArr As Variant, iColumn&, iRow&
iArr = Array("Ключевое слово", "Слов", "Символов", "Частотность Весь мир", "" & Chr(34) & "!Частотность !Весь !мир" & Chr(34) & "")
iRow = ActiveSheet.UsedRange.Row
For iColumn = Cells(iRow, Columns.Count).End(xlToLeft).Column To 1 Step -1
If IsError(Application.Match(Cells(iRow, iColumn), iArr, 0)) Then Columns(iColumn).Delete
Next
End Sub
Добавляю выше макрос в ваш в таком виде?
'открываем книгу
Set wb = Application.Workbooks.Open(sFolder & sFiles)
'действия с файлом
'Запишем на первый лист книги в ячейку А1 -
Dim iArr As Variant, iColumn&, iRow&
iArr = Array("Ключевое слово", "Слов", "Символов", "Частотность Весь мир", "" & Chr(34) & "!Частотность !Весь !мир" & Chr(34) & "")
iRow = ActiveSheet.UsedRange.Row
For iColumn = Cells(iRow, Columns.Count).End(xlToLeft).Column To 1 Step -1
If IsError(Application.Match(Cells(iRow, iColumn), iArr, 0)) Then Columns(iColumn).Delete
Next
'Закрываем книгу с сохранением изменений
wb.Close True 'если поставить False - книга будет закрыта без сохранения
sFiles = Dir
Во всех файлах все колонки просто удаляются :(
Подскажите где может быть ошибка?
без файлов нереально сказать где именно. Но ошибка явно здесь:
If IsError(Application.Match(Cells(iRow, iColumn), iArr, 0)) Then
Match скорее всего не находит совпадений. Ищите через режим отладки проблему(может там переносы лишние или пробелы или еще что-то)
День добрый.
За код спасибо. Пока работаю с xls* - всё отлично, как только пытаюсь работать с doc*, то вылетает ошибка "класс не зарегистрирован". Подгружен Word 14.0, офис 2010
Alex, не знаю как именно Вы работает с "doc" в данном случае. Но могу сказать одно: код здесь ни при чем. Скорее всего это ошибка офиса и VBA не может обратиться к объекту Wordа. Попробуйте переустановить офис полностью.
Добрый день.
Код работает, спасибо. Но есть вопрос.
У меня есть несколько файлов в папке, на каждом листе из которых происходят действия. Но после сохранения файлы открываются на последнем листе книги. Можно ли как-то исправить? чтобы файлы сохранялись на первом листе
Наталья, если честно - конкретики мало, одни догадки. Какие действия, кто их делает, в какой момент...Причем здесь код просмотра файлов из статьи...В общем случае должен сработать такой код(строку надо записать ПЕРЕД строкойwb.Close True ):
Здравствуйте!
Спасибо за код. Скажите, пожалуйста, как сделать так, чтобы при открытии каждого файла в выбранной папке не всплывало окно с предупреждением "Будьте внимательны! В документе могут быть персональные данные, которые невозможно удалить с помощью инспектора документов."
Борис, скорее надпись выскакивает перед сохранением файла. Убрать можно так:
перед строкой
пишите такие:
т.е. убираете галочку по персональных данных кодом.
Добрый день. Помогите, пожалуйста, как дописать код, чтоб все файлы excel сохранялись в pdf в этой же папке с этим же именем.
Пробую сделать вот так и не получается:
Dim sFolder As String, sFiles As String
Dim wb As Workbook
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
sFolder = .SelectedItems(1)
End With
sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
Application.ScreenUpdating = False
sFiles = Dir(sFolder & "*.xls*")
Do While sFiles ""
Set wb = Application.Workbooks.Open(sFolder & sFiles)
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=(ActiveWorkbook.FullName & ".pdf"), Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
wb.Close True
sFiles = Dir
Loop
Application.ScreenUpdating = True
End Sub
Анна, так вроде насколько вижу и Ваш правленный код должен это делать без проблем. Единственное, я бы делал так(чтобы обращаться именно к открытой книге и чтобы не было задвоения расширения файла):