Добрый день! Прошу помощи с реализацией следующего: 1. есть файл Excel, в котором содержится поле для ввода информации для поиска; 2. есть набор файлов .docx, которые выступают в качестве "базы данных"; 3. необходимо осуществить поиск информации из поля в Excel по "базе данных".
Пока получается открыть файл .docx из Excel:
[vba]
Код
Sub OpenDoc() Dim WordObj As Object Dim WordDoc As Object Set WordObj = CreateObject("Word.Application") Set WordDoc = WordObj.Documents.Open("C:\Перечень стратегов по Распоряжению правительства.docx") 'WordObj.Visible = True Set WordDoc = Nothing Set WordObj = Nothing End Sub
[/vba] И есть понимание, что поиск в открытом файле должен осуществляться через ActiveDocument.Content.Find, но как сделать активным именно открытый документ, понимания нет. Пример файла "базы данных" во вложении.
P.S. К сожалению, перевести файлы .docx в другой формат не получится, потому что они все время меняются/удаляются/добавляются. Нет, наверное эту задачу можно быстро и легко реализовать с помощью других языков, но знаний хватает только на работу с VBA на уровне copy-paste.
Добрый день! Прошу помощи с реализацией следующего: 1. есть файл Excel, в котором содержится поле для ввода информации для поиска; 2. есть набор файлов .docx, которые выступают в качестве "базы данных"; 3. необходимо осуществить поиск информации из поля в Excel по "базе данных".
Пока получается открыть файл .docx из Excel:
[vba]
Код
Sub OpenDoc() Dim WordObj As Object Dim WordDoc As Object Set WordObj = CreateObject("Word.Application") Set WordDoc = WordObj.Documents.Open("C:\Перечень стратегов по Распоряжению правительства.docx") 'WordObj.Visible = True Set WordDoc = Nothing Set WordObj = Nothing End Sub
[/vba] И есть понимание, что поиск в открытом файле должен осуществляться через ActiveDocument.Content.Find, но как сделать активным именно открытый документ, понимания нет. Пример файла "базы данных" во вложении.
P.S. К сожалению, перевести файлы .docx в другой формат не получится, потому что они все время меняются/удаляются/добавляются. Нет, наверное эту задачу можно быстро и легко реализовать с помощью других языков, но знаний хватает только на работу с VBA на уровне copy-paste.tsch
Sub OpenDoc() Dim i As String Dim WordObj As Object Dim WordDoc As Object
i = Worksheets("Лист1").Cells(1, 1).Value
Set WordObj = CreateObject("Word.Application") Set WordDoc = WordObj.Documents.Open("C:\Перечень стратегов по Распоряжению правительства.docx") 'WordObj.Visible = True WordDoc.Select If WordObj.Selection.Find.Text = i Then MsgBox ("Соответствие найдено") Else MsgBox ("Соответствие не найдено") End If WordDoc.Close True WordObj.Quit Set WordDoc = Nothing Set WordObj = Nothing End Sub
[/vba]
Макрос выдает ответ "Соответствие не найдено", хотя информация в документе точно содержится.
Удалось продвинуться до следующего состояния:
[vba]
Код
Sub OpenDoc() Dim i As String Dim WordObj As Object Dim WordDoc As Object
i = Worksheets("Лист1").Cells(1, 1).Value
Set WordObj = CreateObject("Word.Application") Set WordDoc = WordObj.Documents.Open("C:\Перечень стратегов по Распоряжению правительства.docx") 'WordObj.Visible = True WordDoc.Select If WordObj.Selection.Find.Text = i Then MsgBox ("Соответствие найдено") Else MsgBox ("Соответствие не найдено") End If WordDoc.Close True WordObj.Quit Set WordDoc = Nothing Set WordObj = Nothing End Sub
[/vba]
Макрос выдает ответ "Соответствие не найдено", хотя информация в документе точно содержится.tsch
Сообщение отредактировал tsch - Пятница, 09.02.2018, 09:03
Ответ колхозным способом найден, может кому-то пригодится:
[vba]
Код
Sub StrategFinder() Dim i As String Dim WordObj As Object Dim WordDoc As Object
i = InputBox("Скопируйте наименование организации: ")
Set WordObj = CreateObject("Word.Application") Set WordDoc = WordObj.Documents.Open("C:\Перечень стратегов по Распоряжению правительства.docx") WordDoc.Select WordObj.Selection.Find.ClearFormatting If WordObj.Selection.Find.Execute(i) = True Then MsgBox ("Найдено соответствие в перечне Правительства №91-Р") Else MsgBox ("Соответствие не найдено") End If WordDoc.Close True WordObj.Quit
Set WordDoc = Nothing Set WordObj = Nothing End Sub
[/vba]
Буду благодарен за более изящное решение, потому что сейчас перебор между файлами "базы данных" реализован убого:
[vba]
Код
Set WordDoc = WordObj.Documents.Open("C:\n-й файл.docx") WordDoc.Select WordObj.Selection.Find.ClearFormatting If WordObj.Selection.Find.Execute(i) = True Then MsgBox ("Найдено соответствие в n-ом файле") Else MsgBox ("Соответствие не найдено") End If WordDoc.Close True WordObj.Quit
[/vba] И так по всей базе.
Ответ колхозным способом найден, может кому-то пригодится:
[vba]
Код
Sub StrategFinder() Dim i As String Dim WordObj As Object Dim WordDoc As Object
i = InputBox("Скопируйте наименование организации: ")
Set WordObj = CreateObject("Word.Application") Set WordDoc = WordObj.Documents.Open("C:\Перечень стратегов по Распоряжению правительства.docx") WordDoc.Select WordObj.Selection.Find.ClearFormatting If WordObj.Selection.Find.Execute(i) = True Then MsgBox ("Найдено соответствие в перечне Правительства №91-Р") Else MsgBox ("Соответствие не найдено") End If WordDoc.Close True WordObj.Quit
Set WordDoc = Nothing Set WordObj = Nothing End Sub
[/vba]
Буду благодарен за более изящное решение, потому что сейчас перебор между файлами "базы данных" реализован убого:
[vba]
Код
Set WordDoc = WordObj.Documents.Open("C:\n-й файл.docx") WordDoc.Select WordObj.Selection.Find.ClearFormatting If WordObj.Selection.Find.Execute(i) = True Then MsgBox ("Найдено соответствие в n-ом файле") Else MsgBox ("Соответствие не найдено") End If WordDoc.Close True WordObj.Quit
Не совсем понятно, чем вам помочь, то что вы написали можно чуть подправить [vba]
Код
Sub StrategFinder() Dim i As String Dim WordObj As Object Dim WordDoc As Object
i = InputBox("Скопируйте наименование организации: ")
Set WordObj = CreateObject("Word.Application") Set WordDoc = WordObj.Documents.Open(Filename:="C:\temp\Перечень стратегов по Распоряжению правительства.docx", ReadOnly:=True) With WordDoc.Content .Find.ClearFormatting If .Find.Execute(FindText:=i, Forward:=True) = True Then MsgBox ("Найдено соответствие в перечне Правительства №91-Р") Else MsgBox ("Соответствие не найдено") End If End With WordDoc.Close True WordObj.Quit Set WordDoc = Nothing Set WordObj = Nothing End Sub
[/vba]
но стандартный поиск windows даст результат при поиске в каталоге даже наверно быстрее. Например вот так в поисковой строке "content: РОСНЕФТЕГАЗ" бе кавычек выдаст тот файл(ы) в котором(ых) есть это слово. Я не знаю как в русскоязычном варианте будет.
Не совсем понятно, чем вам помочь, то что вы написали можно чуть подправить [vba]
Код
Sub StrategFinder() Dim i As String Dim WordObj As Object Dim WordDoc As Object
i = InputBox("Скопируйте наименование организации: ")
Set WordObj = CreateObject("Word.Application") Set WordDoc = WordObj.Documents.Open(Filename:="C:\temp\Перечень стратегов по Распоряжению правительства.docx", ReadOnly:=True) With WordDoc.Content .Find.ClearFormatting If .Find.Execute(FindText:=i, Forward:=True) = True Then MsgBox ("Найдено соответствие в перечне Правительства №91-Р") Else MsgBox ("Соответствие не найдено") End If End With WordDoc.Close True WordObj.Quit Set WordDoc = Nothing Set WordObj = Nothing End Sub
[/vba]
но стандартный поиск windows даст результат при поиске в каталоге даже наверно быстрее. Например вот так в поисковой строке "content: РОСНЕФТЕГАЗ" бе кавычек выдаст тот файл(ы) в котором(ых) есть это слово. Я не знаю как в русскоязычном варианте будет.bmv98rus
Замечательный Временно просто медведь , процентов на 20.
Сообщение отредактировал bmv98rus - Пятница, 09.02.2018, 14:05