Excel поиск файла по имени

lenok Пользователь Сообщений: 39 Регистрация: 23.05.2013	Помогите, пожалуйста. Как в определенной папке с помощью макроса найти и открыть фаил с названием из ячейки??? Заранее, спасибо большое

Johny Пользователь Сообщений: 2737 Регистрация: 21.12.2012	А файл какой? Excel? There is no knowledge that is not power

lenok Пользователь Сообщений: 39 Регистрация: 23.05.2013	да. в 2003 экселе пытаюсь написать

Johny Пользователь Сообщений: 2737 Регистрация: 21.12.2012

#4 23.05.2013 11:40:58 Код Sub f()     Dim f As String, folder As String, file_name As String     'Папка для поиска     folder = "C:Temp"          'Ячейка с именем файла     file_name = Range("A1")          f = Dir(folder)     While Not Len(f) = 0         If f = file_name Then             Workbooks.Open folder & f         End If         f = Dir()     Wend End Sub There is no knowledge that is not power

lenok Пользователь Сообщений: 39 Регистрация: 23.05.2013

lenok Пользователь Сообщений: 39 Регистрация: 23.05.2013	а как сделать, чтобы выбор варианта ответа при появлении диалогового окна был автоматический, или чтобы оно вообще не вылазило???

Johny Пользователь Сообщений: 2737 Регистрация: 21.12.2012	#7 24.05.2013 14:28:11 Код Application.DisplayAlerts = False ..... ..... ..... Application.DisplayAlerts = True Изменено: Johny — 24.05.2013 14:28:36 There is no knowledge that is not power

lenok Пользователь Сообщений: 39 Регистрация: 23.05.2013	а можно ли сделать, чтобы он искал документ в поддиректориях???

Johny Пользователь Сообщений: 2737 Регистрация: 21.12.2012

#9 31.05.2013 17:18:58 Ставим галку: Tools -> References -> Microsoft Scripting Runtime Код Private file_name As String Private f As File, fld As folder Sub SearchAndOpen()     Dim source_folder As String     Dim fso As New FileSystemObject     'Папка для поиска     source_folder = "C:TempDir"          'Ячейка с именем файла     file_name = Range("A1")          Call EnumerateFiles(fso.GetFolder(source_folder)) End Sub Private Sub EnumerateFiles(root_folder As folder)     For Each f In root_folder.Files         If f.Name = file_name Then             Workbooks.Open f.Path         End If     Next          For Each fld In root_folder.SubFolders         Call EnumerateFiles(fld)     Next      End Sub Изменено: Johny — 31.05.2013 17:19:49 There is no knowledge that is not power

Hugo Пользователь Сообщений: 23249 Регистрация: 22.12.2012	#10 31.05.2013 17:29:09 Я чего-то не понимаю? Если есть имя файла — то зачем искать? Взяли и открыли. Если ошибка — обработали. А искать может быть долго — если например файлов тысячи. Да и код с таким поиском больно длинный  — хватает ведь 3-х строк: Код Sub f()     On Error GoTo err_: Workbooks.Open "C:Temp" & Range("A1"): Exit Sub err_:     MsgBox "Нет такого файла!" End Sub

Юрий М Модератор Сообщений: 60570 Регистрация: 14.09.2012 Контакты см. в профиле	Я тоже не понимаю смысла в поиске…

KuklP Пользователь Сообщений: 14868 Регистрация: 21.12.2012 E-mail и реквизиты в профиле.	Я сам — дурнее всякого примера! …

lenok Пользователь Сообщений: 39 Регистрация: 23.05.2013	Просто документов очень много. и постоянно открывать файлы под определенными названиями….. смысл тогда составления макроса… Пишу для автоматизации процессов обработки информации, и остановилась на этом моменте.

Hugo Пользователь Сообщений: 23249 Регистрация: 22.12.2012

Если например ситуации такие: — есть точный список названий файлов — в определённом месте (папки/подпапки) регулярно генерятся файлы (известна часть имени, или даже не известна) — нужно открыть все файлы определённой папки/подпапки — есть какая-то другая система в этих файлах и открывать такие файлы предстоит регулярно — то есть смысл один раз и надолго облегчить себе работу макросом. Если же никакой системы нет — то и макросом открывать файлы нет смысла. Другое дело, что если обработка этих открываемых файлов предстоит макросом — то можно в этот же макрос вписать диалог выбора этих файлов. Т.е. запустили макрос, в диалоге указали сразу все нужные файлы, получили готовый результат.

lenok Пользователь Сообщений: 39 Регистрация: 23.05.2013

Есть огромный отчет. после обработки макросом, надо, чтобы он брал имя файла из определенной ячейки и открывал фаил с таким именем. информации много, и такой отчет обрабатывается каждый месяц. примерное кол-во файлов на один отчет больше 1000, поэтому, сами понимаете, что открывать каждый, это рутина. таких отчетов за один месяц 30 штук. соответственно, около 30000 существующих файлов…вот как-то так все глобально…… просто открыть, с этим мы разобрались….. но некоторые файлы находятся в поддиректориях, и постоянно происходят какие-то перемещения в этой директории…

Hugo Пользователь Сообщений: 23249 Регистрация: 22.12.2012

#16 03.06.2013 11:32:43 В теме http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=8&TID=25457 есть файл http://www.planetaexcel.ru/bitrix/components/bitrix/forum.interface/show_file.php?fid=40202&action=download Там есть такой код: Код     For Each aFolder In fso.GetFolder(ThisWorkbook.Path).Files              For Each aFile In aFolder.Files                      If fso.GetExtensionName(aFile.Name) Like "xls*" Then                              Set wkb = Workbooks.Open(aFile.Path)                 Set wks = wkb.Worksheets(1)                 With wks и т.д. Думаю, можно использовать.

lenok Пользователь Сообщений: 39 Регистрация: 23.05.2013	что-то я не могу разобраться совсем

anvg Пользователь Сообщений: 11878 Регистрация: 22.12.2012 Excel 2016, 365	Пробуйте, первый запуск будет долгим. Далее быстрее. Если есть подозрение, что файлы в папке и подпапках изменили положение или имя, то нажать «Обновить». Путь к начальной папке задаётся константой baseFolder в методе InitializeFindю Успехов.

lenok Пользователь Сообщений: 39 Регистрация: 23.05.2013	#19 04.06.2013 07:29:04 Код     Const baseFolder = "d:project" я так понимаю, здесь надо прописать адрес самой папки, это понятно… а имя файла он где будет брать???

anvg Пользователь Сообщений: 11878 Регистрация: 22.12.2012 Excel 2016, 365	#20 04.06.2013 07:50:49 Цитата а имя файла он где будет брать??? Из активной ячейки (в ней только имя, без расширения) Изменено: anvg — 04.06.2013 07:52:42

lenok Пользователь Сообщений: 39 Регистрация: 23.05.2013

#21 04.06.2013 08:07:46 все, поняла….. все работает…спасибо большое….    и еще один вопрос, если можно….: как это все сделать так, чтобы он был без этих кнопочек, а в таком виде, чтобы автоматически включался??? до этого было прописано так, но он только с одной папки так открывает…. Заранее огромное спасибо вам!!!!!!!!     Код Sub ARM()     Dim f As String, folder As String, file_name As String     'Папка для поиска     folder = "C:Documents and SettingsmaksРабочий столДокументы"     'Ячейка с именем файла     file_name = LCase(Range("D1")) & ".xls"     f = Dir(folder)     While Not Len(f) = 0         If LCase(f) = file_name Then             Workbooks.Open folder & f            Application.Run "ARM.XLS!ARM6"             Exit Sub         End If         f = Dir()     Wend     Application.Run "ARM.XLS!ARM4" End Sub Изменено: lenok — 04.06.2013 23:58:03

KuklP Пользователь Сообщений: 14868 Регистрация: 21.12.2012 E-mail и реквизиты в профиле.

#22 04.06.2013 08:24:36 А на кой тут цикл? Если имя файла известно, зачем перебирать все файлы? Код Sub ARM()     Dim folder As String, file_name As String     'Папка для поиска     folder = "C:Documents and SettingsmaksРабочий столДокументы"     'Ячейка с именем файла     file_name = LCase(Range("D1")) & ".xls"     If Len(Dir(folder & file_name)) Then         Workbooks.Open folder & file_name         Application.Run "ARM.XLS!ARM6"         Exit Sub     End If     Application.Run "ARM.XLS!ARM4" End Sub Я сам — дурнее всякого примера! …

lenok Пользователь Сообщений: 39 Регистрация: 23.05.2013	он не открывает тогда файл в поддиректории

KuklP Пользователь Сообщений: 14868 Регистрация: 21.12.2012 E-mail и реквизиты в профиле.	Ага. А с циклом, следовательно, открывает? Я сам — дурнее всякого примера! …

lenok Пользователь Сообщений: 39 Регистрация: 23.05.2013	неа…  тоже не открывает….   а надо, чтобы открывал… там мне уже без разницы, есть цикл или нет… надо, чтобы он поддиректории просматривал

anvg Пользователь Сообщений: 11878 Регистрация: 22.12.2012 Excel 2016, 365	#26 04.06.2013 09:43:56 Скрытый текст

lenok Пользователь Сообщений: 39 Регистрация: 23.05.2013

Sandero Пользователь Сообщений: 14 Регистрация: 27.02.2014	#28 18.06.2019 13:20:28 Цитата Hugo написал: Я чего-то не понимаю?Если есть имя файла — то зачем искать? Взяли и открыли. Если ошибка — обработали.А искать может быть долго — если например файлов тысячи. Да и код с таким поиском больно длинный  — хватает ведь 3-х строк Добрый день! Попробовал ваш вариант, работает. Я правда добавил ещё запуск другого макроса по созданию файла с этим именем если его нет (т.е. если не выполнено первое условие) Эксель при отсутствии файла выдаёт своё собственное сообщение По нажатии «оК» появляется уже месседж из макроса. М.б. это связано с версией экселя, у меня 2016, а тут код вроде для 2003 изначально, или это не имеет значения. Можно ли убрать сообщение самого экселя? Заранее благодарен!! Код Sub SearhFiles() 'Макрос поиска файла с именем и автоматическое его открытие при наличии On Error GoTo err_: Workbooks.Open "\Server777S" & Range("F2") & ".xls": Exit Sub err_:     MsgBox "Нет такого файла!" Application.Run "DOC.xlsm!Upload" 'Запуск макроса по созданию файла с именем End Sub

200?’200px’:»+(this.scrollHeight+5)+’px’);»> Sub d()
Dim f, i&, ii&, ar(), fol$, NewFol$
ar = [a2:a290].Value ‘Selection.Value
fol = [c2]
NewFol = [d2]
f = Enlist_Directories(fol)
For i = 1 To UBound(ar)
For ii = 0 To UBound(f)
If f(ii) Like «*» & ar(i, 1) & «*» Then Copy_File f(ii), NewFol & Dir(f(ii))
Next ii, i
End Sub
Private Function Copy_File(ByVal sFileName As String, ByVal sNewFileName As String) As Boolean
Dim objFSO As Object
If sFileName = sNewFileName Then Exit Function
If Dir(sFileName, 16) = «» Then: Exit Function
If Not Dir(sNewFileName, 16) = «» Then Kill sNewFileName
Set objFSO = CreateObject(«Scripting.FileSystemObject»)
Call objFSO.CopyFile(sFileName, sNewFileName)
Copy_File = True
End Function
Function Enlist_Directories(strPath As String)
Dim strFldrList() As String
Dim lngArrayMax, x As Long, lngSheet&
lngSheet = 100 ‘As Long
lngArrayMax = 0
strFn = Dir(strPath & «*.*», 23)
While strFn <> «»

If Not (GetAttr(strPath & strFn) And vbDirectory) = vbDirectory Then
lngArrayMax = lngArrayMax + 1
ReDim Preserve strFldrList(lngArrayMax)
strFldrList(lngArrayMax) = strPath & strFn
End If

strFn = Dir()
Wend
Enlist_Directories = strFldrList
End Function

200?’200px’:»+(this.scrollHeight+5)+’px’);»> Sub d()
Dim f, i&, ii&, ar(), fol$, NewFol$
ar = [a2:a290].Value ‘Selection.Value
fol = [c2]
NewFol = [d2]
f = Enlist_Directories(fol)
For i = 1 To UBound(ar)
For ii = 0 To UBound(f)
If f(ii) Like «*» & ar(i, 1) & «*» Then Copy_File f(ii), NewFol & Dir(f(ii))
Next ii, i
End Sub
Private Function Copy_File(ByVal sFileName As String, ByVal sNewFileName As String) As Boolean
Dim objFSO As Object
If sFileName = sNewFileName Then Exit Function
If Dir(sFileName, 16) = «» Then: Exit Function
If Not Dir(sNewFileName, 16) = «» Then Kill sNewFileName
Set objFSO = CreateObject(«Scripting.FileSystemObject»)
Call objFSO.CopyFile(sFileName, sNewFileName)
Copy_File = True
End Function
Function Enlist_Directories(strPath As String)
Dim strFldrList() As String
Dim lngArrayMax, x As Long, lngSheet&
lngSheet = 100 ‘As Long
lngArrayMax = 0
strFn = Dir(strPath & «*.*», 23)
While strFn <> «»

If Not (GetAttr(strPath & strFn) And vbDirectory) = vbDirectory Then
lngArrayMax = lngArrayMax + 1
ReDim Preserve strFldrList(lngArrayMax)
strFldrList(lngArrayMax) = strPath & strFn
End If

strFn = Dir()
Wend
Enlist_Directories = strFldrList
End Function

Иногда все проще чем кажется с первого взгляда.

200?’200px’:»+(this.scrollHeight+5)+’px’);»> Sub d()
Dim f, i&, ii&, ar(), fol$, NewFol$
ar = [a2:a290].Value ‘Selection.Value
fol = [c2]
NewFol = [d2]
f = Enlist_Directories(fol)
For i = 1 To UBound(ar)
For ii = 0 To UBound(f)
If f(ii) Like «*» & ar(i, 1) & «*» Then Copy_File f(ii), NewFol & Dir(f(ii))
Next ii, i
End Sub
Private Function Copy_File(ByVal sFileName As String, ByVal sNewFileName As String) As Boolean
Dim objFSO As Object
If sFileName = sNewFileName Then Exit Function
If Dir(sFileName, 16) = «» Then: Exit Function
If Not Dir(sNewFileName, 16) = «» Then Kill sNewFileName
Set objFSO = CreateObject(«Scripting.FileSystemObject»)
Call objFSO.CopyFile(sFileName, sNewFileName)
Copy_File = True
End Function
Function Enlist_Directories(strPath As String)
Dim strFldrList() As String
Dim lngArrayMax, x As Long, lngSheet&
lngSheet = 100 ‘As Long
lngArrayMax = 0
strFn = Dir(strPath & «*.*», 23)
While strFn <> «»

If Not (GetAttr(strPath & strFn) And vbDirectory) = vbDirectory Then
lngArrayMax = lngArrayMax + 1
ReDim Preserve strFldrList(lngArrayMax)
strFldrList(lngArrayMax) = strPath & strFn
End If

strFn = Dir()
Wend
Enlist_Directories = strFldrList
End Function

Источник

Получение списка файлов в папке и подпапках средствами VBA

Функция FilenamesCollection предназначена для получения списка файлов из папки, с учётом выбранной глубины поиска в подпапках.

Используется рекурсивный перебор папок, до заданного уровня вложенности.
В процессе перебора папок, пути у найденным файлам помещаются в коллекцию (объект типа Collection) для последующего перебора.

К статье прикреплено 2 примера файла с макросами на основе этой функции:

• Пример в файле FilenamesCollection.xls выводит список файлов на чистый лист новой книги (формируя заголовки)
• Пример в файле FilenamesCollectionEx.xls более функционален — он, помимо списка файлов из папки, отображает размер файла, и дату его создания, а также формирует в ячейках гиперссылки на найденные файлы.
  Вывод списка производится на лист запуска, параметры поиска файлов задаются в ячейках листа (см. скриншот)

Смотрите также расширенную версию макроса на базе этой функции:

Макрос FolderStructure выводит в таблицу Excel список файлов и подпапок с отображением структуры (вложенности файлов и подпапок)

ПРИМЕЧАНИЕ: Если вы выводите на лист список имен файлов картинок (изображений), то при помощи этой надстройки вы сможете вставить сами картинки в ячейки соседнего столбца (или в примечания к этим ячейкам)

‘ Пример использования функции в макросе:

Этот код позволяет осуществить поиск нужных файлов в выбранной папке (включая подпапки), и выводит полученный список файлов на лист книги Excel:

Ещё один пример использования:

PS: Найти подходящие имена файлов в коллекции можно при помощи следующей функции:

Комментарии

Не знаю что там за проблема с некорректными именами файлов, — я этот код использовал в сотнях макросов, эта функция работает в составе моих надстроек на десятках тысяч компьютеров, и никаких проблем не наблюдается.
И ни разу я не применял имена MS DOS..

Игорь, спасибо за рабочий пример (немного докрутил и использую в работе).
Что касается вопроса с некорректными именами файлов (которые не любит обрабатывать сей код (например, если в имени есть символ из непонятной кодировки)), выход нашел немного «топорный»: внутри обработки применяю имена MS DOS, которые обрабатываются нормально в большинстве случаев, а в интерфейсе делаю подмену имен на виндовые. Возможно не совсем понятно написал, но примера сейчас нет под рукой.

Спасибо автору, хороший код для поиска файлов, но возникает вопрос, а можно отключить отображение поиска внизу экселя?

Добрый день, а есть возможность применить свой макрос к полученному списку файлов?

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

Посоветуйте пожалуйста как с помощью FSO получить доступ к полям Теги и Комментарии. Спасибо Alexander A. Rylov

Михаил, найдите в верхней части кода строку Option Explicit
и удалите её (эта строка требует объявлять переменные)

Подскажите. Почему excel может ругаться на
Set FSO = CreateObject(«Scripting.FileSystemObject») ‘ создаём экземпляр FileSystemObject
Пишет что переменная не объявлена/не определена

Нужно выше дописать
Dim FSO As Object?
Или в настройках excel 2016 что-то не так? Притом ругается на все не объявленные переменные.
А переменные типа Filename$ вообще не воспринимает как переменные. В чем может быть дело?
Гуглинг пока не помог.

Здравствуйте.
DoEvents никак не влияет на правильность работы (и не может повлиять)
А количество активных гиперссылок на листе Excel ограничено, — никак не сделать, чтобы на одном листе было более 50 или 65 тысяч АКТИВНЫХ гиперссылок.

Доброго времени суток. Огромное спасибо за программу!

Добавлю от себя и задам вопрос.

При использовании «DoEvents» программа может не правильно работать, в том числе выводить не все значения. Я ее закомментировал.

При привышении 65532 строк гиперссылки прекращают формироваться. Как можно победить?

Здравствуйте.
Под заказ что угодно могу сделать (платно)

Здравствуйте. Для примера из файла «FilenamesCollectionEx.xls» — можете сделать, чтобы выводимый на лист Excel список файлов был отсортирован по размеру(по уменьшению)?

Здравствуйте.
Могу сделать под заказ
Оформляйте заказ на сайте, и обязательно прикрепляйте пример файла с примером результата.

Здравствуйте! Меня тоже интересует макрос по поиску файлов. Можете сделать так что бы в ячейках к примеру A1 задать имя файла, A2 задать тип файла и A3 путь к папке?

Огромное Вам спасибо! Столько времени мне съэкономили.
СПА-СИ-БО! 🙂

Спасибо. Очень полезная вещь!

Здравствуйте, Юрий
Да, это можно исправить, — другой код нужен
(встроенные в VBA функции иногда дают ошибки)

Добрый день
В случае если в именах файлов встречаются нестандартные символы (допустимые в Win) макрос выдает ошибку
Ошибка в строке ДатаСоздания = FileDateTime(ПутьКФайлу)
Можно добавить onError Resume Next но это пропуск ошибки будет а размер файла не будет определен. Есть ли варианты сделать определение размера файлов и для таких файлов тоже?

Пример папки на которой сканирование папки «спотыкается»: https://bit.ly/2zz8Tfw

Игорь, подскажите, а можно ли в файл FilenamesCollectionEx.xls добавить маску имени подпапки, в которой производить поиск? Ситуация: файл с одинаковм именем может лежать в подпапках с разными именами. Я точно знаю, что нужная мне версия должна лежать в определенной подпапке. И проверять таким образом только их?

Так вроде и то и другое выводится
Код открыт ведь, — поменяйте как вам надо, если лишний столбец мешает.

Возможно я слепой или плохо читаю, но я не увидел что-то подобное в коментах. Поэтому мой вопрос следующий: можно как-то сделать так, чтобы выводило только название файла а не весь путь?

Отбой, разобрался. Виноват оказался не этот макрос, а тот, который его результаты использовал. Мораль — люди, не юзайте Dir, если вам нужно что-то сделать с папкой, к которой он обращается.

В моём макросе нет MoveFolder — так что мой макрос точно не виноват в вашей проблеме.
Проблема — либо в неверном использовании MoveFolder (не то или не туда перемещаете), либо нет прав доступа на перемещение в заданное место.

Игорь, всё это прекрасно. Непонятно только, что нужно сделать с Вашим макросом, чтобы после его вызова с папкой можно было бы ещё и что-нибудь сделать, например, переместить. Сейчас после вызова FSO.MoveFolder вылетает с ошибкой Access denied. Проверено, виноват именно Ваш макрос — если закомментировать ТОЛЬКО его вызов, FSO.MoveFolder отрабатывает нормально.

Спасибо, ОГРОМНОЕ.
Выручайте ребята! макрос в целом отличный, но для моих целе нужно немного переделать.
Нужно чтоб все файлы находящиеся в каждой папке были в одной ячейке через разделитель ( | )
Например:
C:images4-20161032g.jpg|C:images4-20161033g.jpg|C:images4-20161033g.jpg

Да, сделал.
Высылайте на почту подробное задание (что и как должно выглядеть, для чего это вообще нужно, и т.д.)
Тогда озвучу сроки и стоимость

Добрый день!
Скажите, пожалуйста, сделали ли вы макрос для Александра?
Если да, то за сколько его можно приобрести?
Если нет, то какие сроки выполнения?
Спасибо!

Напишите на почту стоимость и сроки выполнения

Александр, в этом случае нужен более сложный макрос.
Могу сделать под заказ.

Здравствуйте, Макрос хороший. Всё отлично выводит. Но как сделать дерево? Имеется несколько папок, далее нажимаешь на папку или плюс или еще что-то, она открывается, появляется подпапки, опять жмешь на подпапку появляются подпапки и т.д.

Спасибо, отличный макрос

В ответ на:
Андрей, 15 Мар 2018 — 15:13.#3
Добрый день.
файл 148 знаков (рус.буквы) не обрабатывается,
и сам файл на сервере (если файл на раб.столе то все работает)
какая максимальная длина имени и можно-ли ее обойти.

Ограничение на полное имя файла, включая расширение — 259 символов. Соответственно, все файлы, имеющие более длинное имя при выполнении
Set curfold = FSO.GetFolder(FolderPath)
будут проигнорированы. Тестировал на EX2010, W7 и MSServer 2008. У меня из 28 (curfold.Соunt) файлов реально в коллекции только 15 (curfold.items(1). curfold.items(15))

А как сделать макрос чтобы он мне показал только пустые папки?

Ограничений по длине имени файла, вроде как, нет (по крайней мере, за много лет использования этого кода на тысячах компов, с проблемами не сталкивался)

Добрый день.
файл 148 знаков (рус.буквы) не обрабатывается,
и сам файл на сервере (если файл на раб.столе то все работает)
какая максимальная длина имени и можно-ли ее обойти.

Адаптировал к access — все работает, спасибо, очень помогло

Ринат, посмотрите макрос обработки файлов из папки.
Там выводится диалоговое окно папки, и обрабатываются все файлы в ней (независимо от имён файлов)

Добрый день!
Такой вопрос, в отделе каждый месяц сотрудник ведет отчет по своей работе в табличной форме в ексель каждый в своем файле, а начальству необходимо данные отчеты ввести в свою итоговую таблицу для себя, то есть скопировать данные отчетов с файлов каждого сотрудника в свой отдельный файл. Я создал макрос, для скопирования данных с файлов каждого сотрудника в таблицу файла начальству указывая путь к каждому файлу. Но при этом возникает определенные неудобства, каждый месяц нужно пути к файлам прописывать заново, так как на следующий месяц создаются новые файлы по отчетам, и пути к ним необходимо обновлять. Подскажите пожалуйста, как можно сделать так, чтоб пути к файлам привязывались не по конкретному расположению файла, а например указыванием месяца и года можно было сформировать единый отчет на определенный месяц. Спасибо заранее!

Большое спасибо автору! Список использую для каталогизации архива сканов документов.

Да, можем сделать такой макрос под заказ.
Минимальная стоимость заказа 1500 руб.

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

или например на основе Вашего FilenamesCollectionEx.xls нашел все файлы на диске/папке нужные -нажимаешь на файл и ты нужен выбрать ячейку куда вписать имя файла
заранее спасибо

У меня почему-то размер файла в байтах выводится абсолютно иной, иногда даже с отрицательным значением.
Пример:
1.вес файла 3 840 327 Кб или 3,66 Гб, а таблица выдает «-362 472 675»
2.вес файла 5 082 087 Кб или 4,84 Гб, таблица выдает «909 089 137»

Василий, да, можно добавить.
Пример код можете здесь посмотреть:
http://excelvba.ru/code/MCI

Добрый день! Подскажите, возможно ли добавить столбцы «продолжительность» и «ширина кадра», которые имеются в данных файлов?

Здравствуйте, Елизавета.
Причин может быть несколько, навскидку:
— проблемный файл, или файл, к которому у вас нет доступа (ошибка 53 — файл не найден)
— слишком длинное имя папки (много уровней вложенности) и/или файла
— сбой в файловой системе
— ошибка в макросе (что-то в коде не учтено)

Техподдержка по бесплатным макросам не предоставляется
Если готовы оплатить помощь, — звоните в скайп, могу подключиться к вашему компу и всё исправить.

Игорь, огромное вам спасибо за эту работу!
Несколько лет использую ваш файл для классификации фильмов, но пару недель назад почему-то он перестал работать. Никакой критичности в этом нет, т.к. главное исправила благодаря обсуждениям тут, но мне непонятно и жутко интересно, почему так происходит. Может, это связано с активацией офиса(примерно в то же время было)? Офис 10й.
У меня 2 вкладки в этом файле, обновляю список на 2й, и затем новые позиции копирую в первую (накапливаю). При обновлении списка, после 60-70 позиций, макрос останавливается и сообщает об ошибке Run-time error 53 со сслыкой на строку ДатаСоздания = FileDateTime(ПутьКФайлу). Дело не файле, т.к. его удаление не помогло. Я добавила в скрипт «On Error Resume Next», список обновляется до конца, но перестают запускаться фильмы по гиперссылке в 1й вкладке «не удается открыть указанный файл» (во 2й работают), хотя файл и макросы одни и те же. Знаете, в чем может быть причина?

Источник

Adblock
detector

Поиск файлов в каталоге по части имени из столбца таблицы

Данилкин Дата: Вторник, 15.12.2015, 08:50 | Сообщение № 1 Группа: Пользователи Ранг: Новичок Сообщений: 13 Репутация: 0 ± Замечаний: 0% ± Excel 2013 Доброго дня. Подскажите как правильно решить задачу. Существует таблица описывающая объекты, каждый объект идентифицируется уникальным номером, для каждого объекта имеется фотография, частью имени которой является этот номер, требуется по произвольной выборке уникальных номеров, заданных таблицей excel, найти все файлы в заданном каталоге и его подкаталогах, содержащие в имени этот номер и скопировать их в произвольный каталог. К сообщению приложен файл: Poisk.xlsx (12.0 Kb)   Ответить

SLAVICK Дата: Вторник, 15.12.2015, 11:11 | Сообщение № 2 Группа: Модераторы Ранг: Старожил Сообщений: 2290 Репутация: 766 ± Замечаний: 0% ± 2019 Так? : [vba] Код Sub d() Dim f, i&, ii&, ar(), fol$, NewFol$ ar = [a2:a290].Value ‘Selection.Value fol = [c2] NewFol = [d2] f = Enlist_Directories(fol) For i = 1 To UBound(ar)     For ii = 0 To UBound(f)        If f(ii) Like «*» & ar(i, 1) & «*» Then Copy_File f(ii), NewFol & Dir(f(ii)) Next ii, i End Sub Private Function Copy_File(ByVal sFileName As String, ByVal sNewFileName As String) As Boolean Dim objFSO As Object     If sFileName = sNewFileName Then Exit Function     If Dir(sFileName, 16) = «» Then: Exit Function     If Not Dir(sNewFileName, 16) = «» Then Kill sNewFileName Set objFSO = CreateObject(«Scripting.FileSystemObject») Call objFSO.CopyFile(sFileName, sNewFileName) Copy_File = True End Function Function Enlist_Directories(strPath As String) Dim strFldrList() As String Dim lngArrayMax, x As Long, lngSheet& lngSheet = 100 ‘As Long lngArrayMax = 0 strFn = Dir(strPath & «*.*», 23) While strFn <> «»     If Not (GetAttr(strPath & strFn) And vbDirectory) = vbDirectory Then       lngArrayMax = lngArrayMax + 1       ReDim Preserve strFldrList(lngArrayMax)       strFldrList(lngArrayMax) = strPath & strFn     End If   strFn = Dir() Wend Enlist_Directories = strFldrList End Function [/vba] К сообщению приложен файл: Poisk.xlsm (23.9 Kb) Иногда все проще чем кажется с первого взгляда. Сообщение отредактировал SLAVICK — Вторник, 15.12.2015, 11:13   Ответить

Данилкин Дата: Вторник, 15.12.2015, 11:39 | Сообщение № 3 Группа: Пользователи Ранг: Новичок Сообщений: 13 Репутация: 0 ± Замечаний: 0% ± Excel 2013 SLAVICK, огромное спасибо! Сейчас буду разбираться. SLAVICK   Ответить

Данилкин Дата: Вторник, 15.12.2015, 11:56 | Сообщение № 4 Группа: Пользователи Ранг: Новичок Сообщений: 13 Репутация: 0 ± Замечаний: 0% ± Excel 2013 SLAVICK, не понял, зачем в первой колонке имена файлов, это осталось от проверки?   Ответить

Данилкин Дата: Вторник, 15.12.2015, 12:04 | Сообщение № 5 Группа: Пользователи Ранг: Новичок Сообщений: 13 Репутация: 0 ± Замечаний: 0% ± Excel 2013 SLAVICK, программа завершает работу ошибкой на первом цикле «For ii = 0 To UBound(f)», взглянете, я не вполне понимаю почему, пути на реальные заменил, файл прилагаю.   Ответить

Данилкин Дата: Вторник, 15.12.2015, 12:04 | Сообщение № 6 Группа: Пользователи Ранг: Новичок Сообщений: 13 Репутация: 0 ± Замечаний: 0% ± Excel 2013 SLAVICK, файл все-же прилагаю). К сообщению приложен файл: 0177598.xlsm (22.5 Kb)   Ответить

SLAVICK Дата: Вторник, 15.12.2015, 12:19 | Сообщение № 7 Группа: Модераторы Ранг: Старожил Сообщений: 2290 Репутация: 766 ± Замечаний: 0% ± 2019 зачем в первой колонке имена файлов, это осталось от проверки? Макрос ищет в папке поиска файлы, имена которых содержат данные из 1-й колонки. Я вставил несколько своих реальных имен для проверки. цикле «For ii = 0 To UBound(f)» У Вас в папке «F:TempDataBase» есть файлы? Иногда все проще чем кажется с первого взгляда. Сообщение отредактировал SLAVICK — Вторник, 15.12.2015, 12:20   Ответить

Данилкин Дата: Вторник, 15.12.2015, 13:54 | Сообщение № 8 Группа: Пользователи Ранг: Новичок Сообщений: 13 Репутация: 0 ± Замечаний: 0% ± Excel 2013 SLAVICK, по поводу первого столбца я так и понял, в папку DataBase я, на момент проверки работоспособности, запустил копирование файлов ~200GB и там что-то уже было, не факт, что с указанными в таблице уникальными номерами.   Ответить

SLAVICK Дата: Вторник, 15.12.2015, 14:39 | Сообщение № 9 Группа: Модераторы Ранг: Старожил Сообщений: 2290 Репутация: 766 ± Замечаний: 0% ± 2019 Переделал немного. Прошлый пример смотрел только в строго указанную папку. Сейчас во всех вложенных подпапках тоже. Использовал часть кода отсюда Иногда все проще чем кажется с первого взгляда.   Ответить

Данилкин Дата: Вторник, 15.12.2015, 16:30 | Сообщение № 10 Группа: Пользователи Ранг: Новичок Сообщений: 13 Репутация: 0 ± Замечаний: 0% ± Excel 2013 SLAVICK, спасибо), тестирую. После подстановки путей с старта, наблюдается некторая полуторачасовая задумчивость. но данных много, для поиска, ожидаю.   Ответить

SLAVICK Дата: Вторник, 15.12.2015, 19:06 | Сообщение № 11 Группа: Модераторы Ранг: Старожил Сообщений: 2290 Репутация: 766 ± Замечаний: 0% ± 2019 наблюдается некторая полуторачасовая задумчивость ну судя из : запустил копирование файлов ~200GB — так и должно быть. Если эта процедура многоразовая можно добавить вывод в статусную строку сколько % выполнено. А если на один раз то и так сойдет Иногда все проще чем кажется с первого взгляда. Сообщение отредактировал SLAVICK — Вторник, 15.12.2015, 19:07   Ответить

Данилкин Дата: Среда, 16.12.2015, 14:15 | Сообщение № 12 Группа: Пользователи Ранг: Новичок Сообщений: 13 Репутация: 0 ± Замечаний: 0% ± Excel 2013 SLAVICK, спасибо! Прекрасно отработала! Да и не полтора часа, в первый раз долго было потому что я цифры короткие не убрал ну и файлов конечно нашлось много. А для того чтобы файлы не скопировать, а переместить в этих строчках кода нужно команду заменить? [vba] Код For i = 1 To UBound(ar) For ii = 1 To UBound(f) If f(ii) Like «*» & ar(i, 1) & «*» Then Copy_File f(ii), NewFol & Dir(f(ii)) Next ii, i End Sub [/vba] [vba] Код Private Function Copy_File(ByVal sFileName As String, ByVal sNewFileName As String) As Boolean Dim objFSO As Object If sFileName = sNewFileName Then Exit Function If Dir(sFileName, 16) = «» Then: Exit Function If Not Dir(sNewFileName, 16) = «» Then Kill sNewFileName Set objFSO = CreateObject(«Scripting.FileSystemObject») Call objFSO.CopyFile(sFileName, sNewFileName) Copy_File = True End Function [/vba] [moder]Оформляйте коды тегами! Поправила на первый раз[/moder] Сообщение отредактировал Manyasha — Среда, 16.12.2015, 14:32   Ответить

SLAVICK Дата: Среда, 16.12.2015, 19:22 | Сообщение № 13 Группа: Модераторы Ранг: Старожил Сообщений: 2290 Репутация: 766 ± Замечаний: 0% ± 2019 Попробуйте вместо [vba] Код Call objFSO.CopyFile(sFileName, sNewFileName) [/vba] написать [vba] Код Call objFSO.MoveFile(sFileName, sNewFileName) [/vba]Вроде работает — если что завтра смогу проверить. Иногда все проще чем кажется с первого взгляда.   Ответить

Данилкин Дата: Вторник, 22.12.2015, 09:12 | Сообщение № 14 Группа: Пользователи Ранг: Новичок Сообщений: 13 Репутация: 0 ± Замечаний: 0% ± Excel 2013 SLAVICK, доброго дня! Спасибо огроменское! Прога работает, все как надо выбирает, еще один небольшой ньюанс выявил в процессе эксплуатации, не всегда оказывается есть файлы, наличие которых в каталогах поиска ожидается, как в исходном файле отметить, какие части имен найдены, а какие нет, идеально — любую отметку в колонку рядом, также можно добавить что-то в содержащую часть имени ячейку. Поможете? Сам пока никак не дойду. К сообщению приложен файл: 4025460.xlsm (51.4 Kb)   Ответить

SLAVICK Дата: Вторник, 22.12.2015, 12:01 | Сообщение № 15 Группа: Модераторы Ранг: Старожил Сообщений: 2290 Репутация: 766 ± Замечаний: 0% ± 2019 Рад, что помогло Проще всего добавить массив такой же размерности и там отмечать количество найденных: [vba] Код Sub d() Dim f(), i&, ii&, ar(), ar1(), fol$, NewFol$, coll As Collection ar = [a2:a2471].Value ‘Selection.Value ReDim ar1(1 To UBound(ar), 1 To 1) fol = [c2] NewFol = [d2] Set coll = FilenamesCollection(fol) ReDim f(1 To coll.Count) For ii = 1 To coll.Count f(ii) = coll(ii) Next For i = 1 To UBound(ar)     For ii = 1 To UBound(f)        If f(ii) Like «*» & ar(i, 1) & «*» Then Copy_File f(ii), NewFol & Dir(f(ii)): ar1(i, 1) = ar1(i, 1) + 1 Next ii, i [b2].Resize(UBound(ar1), 1) = ar1 End Sub [/vba] К сообщению приложен файл: 7809360.xlsm (54.1 Kb) Иногда все проще чем кажется с первого взгляда.   Ответить

Данилкин Дата: Понедельник, 28.12.2015, 10:56 | Сообщение № 16 Группа: Пользователи Ранг: Новичок Сообщений: 13 Репутация: 0 ± Замечаний: 0% ± Excel 2013 SLAVICK, урааа, спасибо, всё работает!!!   Ответить