поиск текста в файлах папки и запись результатов

[Composter]

Здравствуйте, форумчане.
немного программирую на vba для excel ,а тут решил для word написать.подскажите как осуществить перебор всех вордовских документов в папке, и найти текст в каждом файле,выделить следующих 50 символов после текста, для последующий записи в другой файл?

[Казанский]

> как осуществить перебор всех вордовских документов в папке
А как бы Вы это сделали для документов Excel?

> найти текст в каждом файле,выделить следующих 50 символов после текста
Запишите макрорекордером.

[@лeся]

Сообщение от Composter

Здравствуйте, форумчане.
немного программирую на vba для excel ,а тут решил для word написать.подскажите как осуществить перебор всех вордовских документов в папке, и найти текст в каждом файле,выделить следующих 50 символов после текста, для последующий записи в другой файл?

и это все не открывая файл? о.О
чудо техники...

[Ципихович Эндрю]

>и это все не открывая файл? о.О
>чудо техники...
быть такого не может!!

[Composter]

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

[Ципихович Эндрю]

> а вот можно ли осуществить поиск текста не делая видимым окно - этого я не знаю
я знаю - можно!

[Composter]

ну я вот накатал макрос по поиску текста внутри файла по 2 фразам.а вот как перебрать файлы doc и docx внутри одной папки не знаю.помогите ...

Option Explicit
Option Base 1
Dim z1 As String, z2 As String
Dim stroka_1 As String, stroka_2 As String

Private Sub poisk_teksta1()
Dim myRange As Range
Dim na4_str As Long, kon_str As Long
Set myRange = ActiveDocument.Content
na4_str = InStr(1, myRange.Text, stroka_1) - 1
kon_str = InStr(1, myRange.Text, stroka_2) - 1
If ((na4_str < 1) Or (kon_str < 1)) Then
    z1 = Null
    z2 = Null
    Exit Sub
End If
Set myRange = ActiveDocument.Range(Start:=na4_str, End:=kon_str)
z1 = myRange.Text
z2 = Left(ActiveDocument.Name, InStr(1, ActiveDocument.Name, ".") - 1)
End Sub

[Sasha_Smirnov]

Нашёл справку: http://vba-help.ru/vbahelp/Function/file/Dir/

Вот до чего дошёл за полчаса:

Sub ShowFileNamesInFolder()
Dim pathto As String, i As Integer, N As Integer
    'N = 3
    'Dialogs(wdDialogFileOpen).Show 'выбрать папку - НЕ ПОЛУЧИЛОСЬ
    'Ниже - установка текущего каталога, в котором будем перебирать файлы
    ChDir ("C:\\Documents and Settings\\Admin\\Рабочий стол\\Word\\")
    pathto = CurDir$
    MsgBox pathto       'показ выбранного (текущего) каталога (пути к файлам)
    MsgBox Dir("")      'показ первого файла в текущем каталоге
End Sub

Хотя (в 20 веке) ходил и дальше.

[Пименов Александр]

Вот примерный макрос перебора файлов с использованием объекта FileDialog

Public Sub Open_Files()
Dim FDlg As FileDialog ' Диалоговое окно для выбора файлов
Dim Doc As Document ' Документ в котором делаем сборку найденного текста
Dim mDoc As Document ' Временный документ созданный при переборе документов выбранных в диалоговом окне
Dim rng As Range ' Место в документе Doc куда будем вставлять найденный текст
    Set FDlg = Application.FileDialog(msoFileDialogFilePicker)
        With FDlg ' Свойства диалогового окна
            .Title = "Открыетие файлов Word"
            .Filters.Clear
            .Filters.Add "Все файлы", "*.doc, *.dot, *.docx, *.dotx, *.docm, *.dotm"
            .Filters.Add "Word 2003", "*.doc, *.dot"
            .Filters.Add "Word 2007-2010", "*.docx, *.dotx, *.docm, *.dotm"
            .ButtonName = "Открыть"
            .FilterIndex = 0
        End With
        FDlg.Show
        Set Doc = Documents.Add ' Создаем файл для сборки найденного текста
        Doc.SaveAs2 ("C:\Моя работа\Сборка.doc")
        For i = 1 To FDlg.SelectedItems.Count
            Set mDoc = Documents.Open(FDlg.SelectedItems(i))
'----------------------------------------------------------------------------------
' Здесь добавляем код по поиску и выделению нужного текста в документе mDoc
'----------------------------------------------------------------------------------
            Selection.Copy
            mDoc.Close
            Set rng = Doc.Range(Doc.Range.End, Doc.Range.End) ' Определяем место вставки в конце документа
            rng.PasteAndFormat
        Next i
End Sub

[Composter]

Пименов Александр ,что то в этой строке выдает ошибку

Set rng = Doc.Range(Start:=Doc.Range.End, End:=Doc.Range.End)

с этим разобрался , заменил на

Selection.EndOf

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