Поиск файла по соддержимому и маске.

[КаМММ]

Макрос работал в 2003 а в 2007 Application.FileSearch убрали.
Как теперь можно средствами Экселя найти нужный файл.
Вот то, что было.

Private Sub ПоискФайла()
Application.ScreenUpdating = False
Filt = "Файлы Таблиц(*.xls),*.xls"
Путь = Application.GetOpenFilename(FileFilter:=Filt)
If Путь = "False" Then Exit Sub
Путь = Mid(Путь, 1, InStrRev(Путь, Application.PathSeparator)) 'Путь файла
MsgBox Путь
'Текст = "Искомый текст задаётся другой процедурой"
'Маска = "Маска файла задаётся другой процедурой"
Set FS = Application.FileSearch
With FS
   .NewSearch
   .LookIn = Путь
   .SearchSubFolders = True
   .TextOrProperty = Текст
   .MatchTextExactly = False
   .Filename = "*" & Маска & "*.xls"
   .Execute
End With
MsgBox FS.FoundFiles.Count
End Sub

(Я всё лишнее убрал)
В конечном итоге интересует как находить файл по содержимому в 2007м экселе.

[КаМММ]

Сообщение от КаМММ

Макрос работал в 2003.
В конечном итоге интересует как находить файл по содержимому в 2007м экселе.

Похоже не одного меня ставит в тупик этот вопрос.
Ни одного ответа. (хотя просмотров много)
Хоть кто-нибудь, помогите!

[Pavel55]

Ответ такой - используйте рекурсию.

Код ищет все файлы Excel (*.xls) в директории C:\Temp\ и вложенных подпапках (C:\Temp\папка1\ и т.д.).
Результат поиска выводится на активный лист в столбце А - путь, в столбце B - имя файла

Sub FolderSubfoldersFSO()
Dim fso As Object, Folder1 As Object, iPath$
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    iPath = "C:\Temp\"    'ActiveWorkbook.Path
    Columns("A:B").ClearContents
    Cells(1, 1) = "Путь": Cells(1, 2) = "Имя файла"
    SearchFolderSubfoldersFSO fso.GetFolder(iPath)
    Columns("A:B").AutoFit
    MsgBox "Просмотр закончен!", 64, "Поиск Excel файлов"
End Sub

Private Sub SearchFolderSubfoldersFSO(Folder1)
Dim fso As Object, Folder2 As Object, iFile As Object

    For Each iFile In Folder1.Files
        If UCase(Right(iFile, 3)) = "XLS" Then
            ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1) = Folder1.Path
            ActiveSheet.Range("B" & Rows.Count).End(xlUp).Offset(1) = iFile.Name
        End If
    Next
    For Each Folder2 In Folder1.SubFolders
        SearchFolderSubfoldersFSO Folder2     'рекурсия
    Next
End Sub

P.S. Источник http://sql.ru/forum/actualthread.aspx?tid=456013

[КаМММ]

Всё это замечательно, кроме одного.
Application.FileSearch имеет свойство или параметр TextOrProperty = "Текст" который я хочу найти в той самой куче файлов.
Как в 2007м найти текст в файле не открывая и не просматривая его?
Может какая-нибудь из API функций? Ведь не могли-же они убрть из 2007го удобный поиск по содержимому, и ни чего не оставить взамен?

[Pavel55]

Боюсь никак. FileSearch заблокирован в 2007. Таким образом нужно открывать каждый файл.

P.S. Может в Excel 2010 будет )

[КаМММ]

Боюсь никак.

Печально. Теперь не удивительно, что я ничего не нашёл.
Буду что-нибудь придумывать.
Тем более что у меня область поиска текста в файле ограничена первой сотней ячеек во втором столбце.
Думаю, что справлюсь.
Спасибо за информацию. (в том числе и по рекурсии)

[КаМММ]

Столкнулся с интересной проблемой при рекурсии.
Если процесс запущен на логическом диске, всё работает нормально.
Если-же запустить в сетевой папке, то начинается путаница с путём вложенных папок.
iFaile и iPath должны быть почти одинаковыми.
Однако почему-то возникает странное несоответствие.
И хотя при этом все файлы в подкаталогах находятся правильно, получить правильное полное имя для iFaile я почему-то не смог.

[КаМММ]

Прикладываю то, что пытался сделать.
За кривизну моего програмного кода прошу не ругать.
Пишу как умею.
Вся система должна просматривать каталог с файлами, и если в каком-то из них во втором столбце находится искомый текст,
то текст ячейки вместе с названием и путём файла вписывается на лист.
Искомый текст берётся из ячейки C1
Вся система работает без открытия просматриваемых файлов. (прописывается ссылка на ячейку в искомом файле, и обновляется значение.)
Вот какраз с формулой - ссылкой и возникают проблемы когда файл находится в сети.

[КаМММ]

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

Dim m As String, Ткст As String, FailMasck As String
Dim Таб(1 To 1000, 1 To 5) As String

Sub FolderSubfoldersFSO()
Ткст = Cells(1, 3) 'Текст который ищем
FailMasck = Cells(1, 4) 'Маска просматриваемых файлов
Dim fso As Object, Folder1 As Object, iPath$
    Set fso = CreateObject("Scripting.FileSystemObject")
'    iPath = ActiveWorkbook.Path
Call ДобДан(iPath)
m = iPath
    Cells(1, 1) = "Путь": Cells(1, 2) = "Имя файла"
     SearchFolderSubfoldersFSO fso.GetFolder(iPath)
Range("A2:E1001").Value = Таб
    Columns("A:B").AutoFit
    MsgBox "Просмотр закончен!", 64, "Поиск Excel файлов"
End Sub

Function ДобДан(Пут As String)
'Добавление данных в расчет из других файлов
With Application.FileDialog(msoFileDialogOpen)
        .FilterIndex = 2
        .InitialFileName = Пут
        .Title = "Открытие файла Данных Excel!"
        .Show
     If .SelectedItems.Count = 0 Then Exit Function
  Пут = .SelectedItems(1) 'найденный файл
    End With
Пут = Mid(Пут, 1, InStrRev(Пут, Application.PathSeparator)) 'Путь файла
End Function

Private Sub SearchFolderSubfoldersFSO(Folder1 As Object)
Application.ScreenUpdating = False 'Может быстрее будет работать?
Application.Calculation = xlCalculationManual 'Может быстрее будет работать?
Dim fso1 As Object, Folder2 As Object, iFile As Object, Об As Integer, Пут As String, ts, rang As Range, i As Integer, i1 As Integer, n As Integer
    For Each iFile In Folder1.Files
If UCase(Right(iFile, 3)) = "XLS" Then 'Проверяем только таблицы (для 2007го может  надо другое расширение)
 On Error Resume Next 'сам не знаю зачем? Может без этого не будет работать?
 Пут = Mid(m, 1, Len(m) - 1) & Mid(Folder1.Path, Len(m), Len(Folder1.Path)) & "\" 'Вот если эту хрень убрать то в сетевых папках теряется
 Имя = iFile.Name 'Имя найденного файла
 If InStr(1, Имя, FailMasck, 1) < 1 Then GoTo vvv 'Файл который не проверяем
 If Имя = "Заказ на воздуховоды.XLS" Then GoTo vvv 'Файл который не проверяем
  ' [Лист2!Z2].Formula = "='" & Пут & "[" & Имя & "]Лист1'!$N$1"'Для проверки тот-ли файл ( все проверяемые файлы имели ону структуру)
   'If [Лист2!Z2].Value <> "Количество" Then [Лист2!Z2].Value = "": GoTo vvv 'Файл который соответствует критерию
   Set rang = Range("Лист2!Z2:Z102") 'В этом месте будем получать данные прописывая ссылку на внешний файл.
   Set fso1 = CreateObject("Scripting.FileSystemObject")
   Set ts = fso1.OpenTextFile(Пут & Имя, 1) 'Проверка существования файла и корректность его имени
   If Err <> 0 Then MsgBox "Файл " & Пут & Имя & " не существует.": GoTo vvv 'Файл который не проверяем
   rang.Formula = "='" & Пут & "[" & Имя & "]Лист1'!$B2" 'Ссылка на 100 ячеек в столбце В в выбранном для поиска файле
   For i1 = 1 To 100
   T = rang(i1).Value
   Об = InStr(1, T, Ткст, 1) 'Проверка наличия искомого текста в строке
         If Об > 0 Then 'текст найден
          n = n + 1
          Таб(n, 1) = Пут 'Путь файла
          Таб(n, 2) = Имя 'Имя файла
          Таб(n, 3) = T 'Текст в ячейке файла соответствующий критерию
          If n = 1000 Then GoTo mmm 'Ограничение числа находок
        Else
        End If
   Next i1
rang.Value = "" 'очистка
vvv:
Else
End If
    Next
    For Each Folder2 In Folder1.SubFolders
        SearchFolderSubfoldersFSO Folder2     'рекурсия
    Next
mmm:
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Если нужен файл могу тоже положить, хотя в нём только две ячейки для масок поиска.(файлы для поиска с искомой информацией в столбце "В" каждый пусть сам себе делает)
Вопрос: Как сделать быстрее работу этого кода.
И извечный: Почему майкрософт такой ГАД? Убрал полезную функцию, из за чего весь этот код пришлось писать!

[КаМММ]

Ещё раз всем здравствуйте.
По результатам проверки оказывается, что макрос находит не все строки, или не во всех файлах.
Помогите ошибку в коде найти!
Где я напутал?