Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Word
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 01.04.2012, 16:18   #11
Пименов Александр
Форумчанин
 
Регистрация: 17.11.2010
Сообщений: 222
По умолчанию

Цитата:
Сообщение от Composter Посмотреть сообщение
подскажите, а можно ли чтобы VBA перебрал доковские файлы в папке, в которой хранится документ с макросом, без диалогового окна?
Можно и без окна.
Для этого нужно объявить объект FSO как FileSystemObject, для этого откройте меню Tools --> References и поставьте галочку на объекте MicrosoftScriptingRuntame, нажмите ОК
Далее можно объявлять объекты FileSystemObject
Код:
Public Sub Open_Files()
Dim FSO As FileSystemObject
Dim Fold As Folder
Dim fl As File
Dim Doc As Document ' Документ в котором делаем сборку найденного текста
Dim mDoc As Document ' Временный документ созданный при переборе документов выбранных в диалоговом окне
Dim rng As Range ' Место в документе Doc куда будем вставлять найденный текст
    Set FSO = New FileSystemObject ' Создаем новый объект FileSystemObject
    Set Doc = ActiveDocument ' Создаем документ сборки из активного документа
    Set Fold = FSO.GetFolder(Doc.Path) ' Определяем папку в которой искать файлы
    For Each fl In Fold.Files ' Перебираем файлы находящиеся в папке Fold
        If fl.Name <> Doc.Name Then ' Условие, если имя файла не равно имени документа сборки то
            Select Case FSO.GetExtensionName(fl) ' Определяем расширение файла
                Case "doc", "docx", "docm" ' Если расширение файла "doc", "docx", "docm" то
                    Set mDoc = Documents.Open(Fold.Name & "\" & fl.Name) ' Открываем временный документ для поиска текста
'----------------------------------------------------------------------------------
' Здесь добавляем код по поиску и выделению нужного текста в документе mDoc
'----------------------------------------------------------------------------------
            Selection.Copy ' Копируем нужный текст
            mDoc.Close ' Закрываем временный файл
            Doc.Activate ' Активизируем документ сборки
'----------------------------------------------------------------------------------
' Переходим в конец документа Doc
'----------------------------------------------------------------------------------
            Selection.PasteAndFormat ' Вставляем текст из буфера обмена в конец документа сборки
            End Select
        End If
    Next fl
End Sub
Пименов Александр вне форума Ответить с цитированием
Старый 02.04.2012, 00:04   #12
Composter
Пользователь
 
Регистрация: 15.10.2010
Сообщений: 35
По умолчанию

спасибо всем,кто помогал, особенно Пименову Александру.
вопрос а если скинуть этот файл на другой комп, та нуна выставлять вот это
"объявить объект FSO как FileSystemObject, для этого откройте меню Tools --> References и поставьте галочку на объекте MicrosoftScriptingRuntame, нажмите ОК"?
выкладываю получившееся
Код:
Option Explicit
Option Base 1
Dim z1 As String, z2 As String
Dim stroka_1 As String, stroka_2 As String
Private Sub poisk_teksta()
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) - 1
If na4_str > 0 Then kon_str = InStr(na4_str, myRange.Text, stroka_2, 1) - 1 - na4_str
If ((na4_str < 0) Or (kon_str < 0)) Then
    z1 = ""
    z2 = ""
    Exit Sub
End If
z2 = Mid(myRange.Text, na4_str, kon_str)
z1 = Left(ActiveDocument.Name, InStr(1, ActiveDocument.Name, ".") - 1)
End Sub
Public Sub Open_Files()
Dim FSO As FileSystemObject
Dim Fold As Folder
Dim fl As File
Dim i As Long
Dim arr1() As Variant
ReDim arr1(2, 1) As Variant
i = 1
Dim Doc As Document ' Документ в котором делаем сборку найденного текста
stroka_1 = InputBox(prompt:="Введите первую строку")
stroka_2 = InputBox(prompt:="Введите вторую строку")
Dim mDoc As Document ' Временный документ созданный при переборе документов выбранных в диалоговом окне
Set FSO = New FileSystemObject ' Создаем новый объект FileSystemObject
Set Doc = ActiveDocument ' Создаем документ сборки из активного документа
Set Fold = FSO.GetFolder(Doc.Path) ' Определяем папку в которой искать файлы
For Each fl In Fold.Files ' Перебираем файлы находящиеся в папке Fold
        If fl.Name <> Doc.Name Then ' Условие, если имя файла не равно имени документа сборки то
            Select Case FSO.GetExtensionName(fl) ' Определяем расширение файла
                Case "doc", "docx", "docm" ' Если расширение файла "doc", "docx", "docm" то
                    Set mDoc = Documents.Open(Doc.Path & "\" & fl.Name) ' Открываем временный документ для поиска текста
            Call poisk_teksta
            mDoc.Close ' Закрываем временный файл
            arr1(1, i) = z1
            arr1(2, i) = z2
            i = i + 1
            ReDim Preserve arr1(2, i) As Variant
            End Select
        End If
    Next fl
Doc.Activate
Selection.EndKey Unit:=wdStory
For i = 1 To UBound(arr1, 2)
    If arr1(1, i) > "" Then
        Selection.Text = arr1(1, i) & vbTab
        Selection.EndOf
        Selection.Text = arr1(2, i) & vbNewLine
        Selection.EndOf
    End If
Next i
End Sub
Composter вне форума Ответить с цитированием
Старый 02.04.2012, 08:21   #13
Пименов Александр
Форумчанин
 
Регистрация: 17.11.2010
Сообщений: 222
По умолчанию

Желательно выполнить действия Tools --> References, т.к. тогда при написании кода будут всплывать подсказки и удобнее работать. Но можно объявить FSO и как объект:
Код:
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Но тогда придется объекты Folder и File объявлять как Object и код со свойствами и методами набирать вручную, а для этого надо знать структуру FileSystemObject
Пименов Александр вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Поиск в файлах папке Dima DDM Общие вопросы Delphi 11 24.04.2011 22:39
Поиск текста в файлах Arassir Общие вопросы по программированию, компьютерный форум 5 08.04.2011 09:22
Запись результатов теста в txt Erick Cartman Общие вопросы Delphi 5 08.03.2010 20:16
Запись в файл результатов! Maria89 Паскаль, Turbo Pascal, PascalABC.NET 4 27.04.2009 23:31