With fs
.LookIn = Range("E2").Value
.Filename = textNamefile
.SearchSubFolders = True
If .Execute > 0 Then
'...
Помогите с функциями поиска в подкаталогах!!!
У нас на фирме программисты написали макрос для создания автопрайсов для клиентов, который призван подбирать картинки, изменять их размер, ну в общем подставлять картинки напротив артикула товара. Чтобы макрос мог подбирать картики, в специальной ячейке указывается путь к папке , вкоторой эти картинки находяться. Неудобство заключается в том, что макрос не просматривает подпапки, которые находятся по указанному пути. Для поиска файлов используется функция lookin. Посоветуйте, может есть другая функция, которая способна заставить макрос осуществлять многоуровневый поиск в подпапках и подкаталогах. Ниже приведу фрагмент, который отвечает за поиск в папке:
Set fs = Application.FileSearch
With fs
.LookIn = Range("E2")
.Filename = textNamefile
If .Execute > 0 Then
For J = 1 To .FoundFiles.Count
ActiveSheet.Pictures.Insert(Range("E2") + "\" + textNamefile).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 111.75
Selection.ShapeRange.Width = 111.75
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementTop 0.75
Selection.ShapeRange.IncrementTop 0.75
Selection.ShapeRange.IncrementTop 0.75
Selection.ShapeRange.IncrementTop 0.75
Range(Cells(I, 1), Cells(I, 1)).Select
Selection.RowHeight = 118
Next J
Else
Range(Cells(I, 1), Cells(I, 1)).Select
Selection.Rows.AutoFit
Set fs = Application.FileSearch
With fs
.LookIn = Range("E2")
.Filename = textNamefile
If .Execute > 0 Then
For J = 1 To .FoundFiles.Count
ActiveSheet.Pictures.Insert(Range("E2") + "\" + textNamefile).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 111.75
Selection.ShapeRange.Width = 111.75
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementTop 0.75
Selection.ShapeRange.IncrementTop 0.75
Selection.ShapeRange.IncrementTop 0.75
Selection.ShapeRange.IncrementTop 0.75
Range(Cells(I, 1), Cells(I, 1)).Select
Selection.RowHeight = 118
Next J
Else
Range(Cells(I, 1), Cells(I, 1)).Select
Selection.Rows.AutoFit
Цитата: Dmitrii
Код:
With fs
.LookIn = Range("E2").Value
.Filename = textNamefile
.SearchSubFolders = True
If .Execute > 0 Then
'...
.LookIn = Range("E2").Value
.Filename = textNamefile
.SearchSubFolders = True
If .Execute > 0 Then
'...
а дублировать эту строку больше нигде не требуется? Просто после добавления этой строки возникли проблемы, макрос не хочет обрабатывать фотки, ругается ошибкой
1004 Невозможно получить свойство Insert класса Pictures
если есть необходимость могу выложить весь макрос...
Цитата: orsy
... макрос не хочет обрабатывать фотки, ругается ошибкой...
Вы забыли о том, что в ячейке Е2 указано имя каталога верхнего уровня, а картинка может быть найдена в одном из подкаталогов.
Замените выражение:
Код:
ActiveSheet.Pictures.Insert(Range("E2") + "\" + textNamefile).Select
на выражение:
Код:
ActiveSheet.Pictures.Insert(.FoundFiles(j)).Select
Кстати, зачем Вам цикл For J = 1 To .FoundFiles.Count? Ведь он будет вставлять в книгу картинку столько раз, сколько будет найдено её экземпляров. Насколько я понимаю, для решения задачи достаточно вставить одну картинку. Если так, то можно использовать оператор:
Код:
ActiveSheet.Pictures.Insert(.FoundFiles(1)).Select
Спасибо огромнейшее!!!! Вы спасли 5 часов моего рабочего времени!!! С меня пиво :)))
Уважаемый Dmitrii, я наверное проявлю верх наглости если попрошу Вас о еще одном акте милосердия. Как написать такую обработку, чтобы путь к найденому файлу выводиля в отдельной колонке напротив найденой фотографии..... пусть это невозможно, но мне кажется, что в поисках подобной функции или примера такой обработки я перерыл "весь интернет".... очень прошу помочь....
Цитата: orsy
... Как написать такую обработку, чтобы путь к найденому файлу выводиля в отдельной колонке напротив найденой фотографии...
Полный путь к найденному файлу возвращает свойство [color=blue]FoundFiles(j)[/color]. Вы уже имеете его в своём распоряжении, так что осталось только вставить это значение (путь к файлу) в нужную ячейку. Например:
Код:
Range("F2").Value = .FoundFiles(j)
Другой пример:
Код:
Range("E2").Offset(0, 1).Value = .FoundFiles(j)
Значение будет помещено в ячейку, смещённую относительно ячейки E2 на 1 столбец вправо (т.е. получится та же ячейка F2, что и в первом примере).
Уважаемый Dmitrii, я немного изменил строчку которую Вы мне посоветовали. В том примере, который Вы мне дали Путь к первому найденому файлу вставлялся в одну ячейку, а затем заменялся на путь к следующему найденому файлу. У меня получилась такая вот строчка:
With fs
.LookIn = Range("E2")
.Filename = textNamefile
.SearchSubFolders = True
If .Execute > 0 Then
For j = 1 To .FoundFiles.Count
ActiveSheet.Pictures.Insert(.FoundFiles(1)).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 111.75
Selection.ShapeRange.Width = 111.75
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementTop 0.75
Selection.ShapeRange.IncrementTop 0.75
Selection.ShapeRange.IncrementTop 0.75
Selection.ShapeRange.IncrementTop 0.75
[COLOR="Lime"]Range(Cells(I, 1), Cells(I, 1)).Offset(0, 5).Value = .FoundFiles(j)[/COLOR]
Range(Cells(I, 1), Cells(I, 1)).Select
Selection.RowHeight = 118
Next j
Спасибо Вам огромномное за помощь!!!
With fs
.LookIn = Range("E2")
.Filename = textNamefile
.SearchSubFolders = True
If .Execute > 0 Then
For j = 1 To .FoundFiles.Count
ActiveSheet.Pictures.Insert(.FoundFiles(1)).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 111.75
Selection.ShapeRange.Width = 111.75
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementTop 0.75
Selection.ShapeRange.IncrementTop 0.75
Selection.ShapeRange.IncrementTop 0.75
Selection.ShapeRange.IncrementTop 0.75
[COLOR="Lime"]Range(Cells(I, 1), Cells(I, 1)).Offset(0, 5).Value = .FoundFiles(j)[/COLOR]
Range(Cells(I, 1), Cells(I, 1)).Select
Selection.RowHeight = 118
Next j
Спасибо Вам огромномное за помощь!!!