Доработка кода VBA
Есть код ВБА. Он работает .. нигде не могу найти команды!!!! Может кто-то поможет ....Код для ексель ... открывает из выбранной папки файлы ворд ищет в них текст(дату), меняет ее на другую сохраняет изменения, открывает следующий и так до конца ....
Что необходимо мне ...
Что бы он открывал ворд искал текст к примеру -**
потом искал текст - ??
Выделял все между ними, копировал и вставлял в ексель (тот из которого запущен код ВБА, можно и создавал новый это не принципиально) допустим в ячейки В1-B50...Копирует он из ворда в ексель и всталяет каждый абзац в отдельную ячейку...50 ячеек просто хватит....Открывая следующий документ он вставлял их уже в 51-100 и т.д. В ячейку А1- название 1 го документа... в ячейку А51-название 2го документа ....
К примеру ... есть документ ворд
**
блабла
??
Он копирует блабла и вставляет их в ячейки с B1-B50? а название в А1,
Следующий такой же- В51-B100, название в А51
Текст программы, которую надо доработать ....
Option Explicit
Dim WordObj As Object
Dim WordDoc As Object
Dim MyPath As String
Dim iFileName As String
Sub Макрос1()
Set WordObj = CreateObject("Word.Application")
MyPath = "C:\Temp\" 'указать путь к папке
iFileName = Dir(MyPath) 'имя первого файла в папке. Не менять!!!
Do While iFileName <> ""
Set WordDoc = WordObj.Documents.Open(MyPath + iFileName) 'открываем первый файл
WordObj.Visible = True 'можно его отображать, можно не отображать
WordObj.Selection.Find.ClearFormatt ing
WordObj.Selection.Find.Replacement. ClearFormatting
With WordObj.Selection.Find
.Text = "21.03.2007" 'текст для поиска
.Replacement.Text = "27.03.2007" 'текст для замены, если мы хотим просто заменить старый
End With
WordObj.Selection.Find.Execute Replace:=2 '2 - означает заменить все
WordObj.Documents(iFileName).Close SaveChanges:=True 'сохраняем и закрываем файл
iFileName = Dir 'получение следующего имени файла в папке. Не менять!!!
Loop
WordObj.Quit 'закрываем MS WORD
Set WordDoc = Nothing 'освобождаем память
Set WordObj = Nothing 'освобождаем память
MsgBox "Файлы обработаны!", vbOKOnly + vbInformation, "Обработка файлов"
End Sub
Просьба помоги кто знает команды, очень надо ... а я совсем начинающий...Дальше замены не продвинулся....
Что необходимо мне ...
Что бы он открывал ворд искал текст к примеру -**
потом искал текст - ??
Выделял все между ними, копировал и вставлял в ексель (тот из которого запущен код ВБА, можно и создавал новый это не принципиально) допустим в ячейки В1-B50...Копирует он из ворда в ексель и всталяет каждый абзац в отдельную ячейку...50 ячеек просто хватит....Открывая следующий документ он вставлял их уже в 51-100 и т.д. В ячейку А1- название 1 го документа... в ячейку А51-название 2го документа ....
К примеру ... есть документ ворд
**
блабла
??
Он копирует блабла и вставляет их в ячейки с B1-B50? а название в А1,
Следующий такой же- В51-B100, название в А51
Текст программы, которую надо доработать ....
Option Explicit
Dim WordObj As Object
Dim WordDoc As Object
Dim MyPath As String
Dim iFileName As String
Sub Макрос1()
Set WordObj = CreateObject("Word.Application")
MyPath = "C:\Temp\" 'указать путь к папке
iFileName = Dir(MyPath) 'имя первого файла в папке. Не менять!!!
Do While iFileName <> ""
Set WordDoc = WordObj.Documents.Open(MyPath + iFileName) 'открываем первый файл
WordObj.Visible = True 'можно его отображать, можно не отображать
WordObj.Selection.Find.ClearFormatt ing
WordObj.Selection.Find.Replacement. ClearFormatting
With WordObj.Selection.Find
.Text = "21.03.2007" 'текст для поиска
.Replacement.Text = "27.03.2007" 'текст для замены, если мы хотим просто заменить старый
End With
WordObj.Selection.Find.Execute Replace:=2 '2 - означает заменить все
WordObj.Documents(iFileName).Close SaveChanges:=True 'сохраняем и закрываем файл
iFileName = Dir 'получение следующего имени файла в папке. Не менять!!!
Loop
WordObj.Quit 'закрываем MS WORD
Set WordDoc = Nothing 'освобождаем память
Set WordObj = Nothing 'освобождаем память
MsgBox "Файлы обработаны!", vbOKOnly + vbInformation, "Обработка файлов"
End Sub
Просьба помоги кто знает команды, очень надо ... а я совсем начинающий...Дальше замены не продвинулся....