Удалить первую страницу если есть одно слово

[Karyuudo]

Здравствуйте.
Есть документы из консультанта, в них помимо колонтитулов иногда не везде на первой странице есть информация название документа и что предоставлен консультантом
вот как пример:

Вот задача проверить наличие слова "КонсультантПлюс" в тексте (не колонтитуле) ну или например картинку с их логотипом. и если встречается, то удалить первую страницу. Как такое сделать?
проблема в том, что я не знаю этот язык.. вот нашел когда-то давно макрос удаления ссылок из документов.
тут как понимаю нужно всего добавить условие поиска слова и если найдено то удалить...

With CreateObject("word.application")
  For Each x In CreateObject("scripting.filesystemobject").getfile(wscript.scriptfullname).parentfolder.Files
    If LCase(Mid(x.Name, InStrRev(x.Name, ".") + 1, 4)) = "rtf" Then
      With .documents.open(x.Path)
        numDocs = numDocs + 1
        .Range.Fields.Unlink 'Ctrl+A, Ctrl+Shift+F9
        .Close True 'save changes
      End With
    End If
  Next
  .Quit
End With
wscript.echo "Обработано документов " & numDocs

но какими командами делается этот поиск и удаление..?

[shanemac51]

хотелось бы увидеть документ
оформление ведь может быть разное

[Karyuudo]

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

хотелось бы увидеть документ
оформление ведь может быть разное

образец документа есть в первом посте на 4 строчке ссылка.
еще раз ссылка на образец документа
Вот если там есть такая страница (она везде одинаковая, только название документа разное) то удалить.
А если там такой страницы нет, то оставить как есть.

[shanemac51]

отрабатывает, но требует доработки(годится в первом приближении)

Sub a_sect140211()
Dim s1, j1, j2, s2, s3
Dim obj As Object
Dim zm1, zm2
zm1 = "КонсультантПлюс"
zm2 = ".consultant."
Dim tbl As Table
''''''''''''''''''''''''''''
s1 = Word.ActiveDocument.Sections(1).Range.Text
If InStr(s1, zm1) > 0 Then
Debug.Print "1ok"
Word.ActiveDocument.Sections(1).Range.Delete
End If
'''''''''''''''''''''''''''''
j1 = Word.ActiveDocument.Sections(1).Headers.Count
Do While j1 > 0
Word.ActiveDocument.Sections(1).Headers(j1).Range.Select
If Selection.Tables.Count > 0 Then
Set tbl = Selection.Tables(1)
j2 = tbl.Range.Cells.Count
Do While j2 > 0
s1 = tbl.Range.Cells(j2).Range.Text
Debug.Print j1, j2, s1;
If InStr(s1, zm1) > 0 Or InStr(s1, zm2) > 0 Then
Debug.Print "**"
tbl.Range.Cells(j2).Range.Text = ""
End If
j2 = j2 - 1
Loop
End If
j1 = j1 - 1
Loop
''''''''''''''''''
j1 = Word.ActiveDocument.Sections(1).Footers.Count
Do While j1 > 0
Word.ActiveDocument.Sections(1).Footers(j1).Range.Select
If Selection.Tables.Count > 0 Then
Set tbl = Selection.Tables(1)
j2 = tbl.Range.Cells.Count
Do While j2 > 0
s1 = tbl.Range.Cells(j2).Range.Text
Debug.Print j1, j2, s1;
If InStr(s1, zm1) > 0 Or InStr(s1, zm2) > 0 Then
Debug.Print "**"
tbl.Range.Cells(j2).Range.Text = ""
End If
j2 = j2 - 1
Loop
End If
j1 = j1 - 1
Loop
  'ActiveWindow.ActivePane.View.Type = wdPrintView
  ActiveWindow.View.Type = wdPrintView
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
 Selection.WholeStory

End Sub

[Karyuudo]

Да спасибо. Супер работает )
вот только если открыть и запустить, а как сделать, чтоб обработались сразу все?

ну вот пример скрипта выше по пробегу по папке, открывая почереди документы для удаления всех ссылок:

With CreateObject("word.application")
  For Each x In CreateObject("scripting.filesystemobject").getfile(wscript.scriptfullname).parentfolder.Files
    If LCase(Mid(x.Name, InStrRev(x.Name, ".") + 1, 4)) = "rtf" Then
      With .documents.open(x.Path)
        numDocs = numDocs + 1
        .Range.Fields.Unlink 'Ctrl+A, Ctrl+Shift+F9 // сюда пробовал вставлять Ваш макрос по удалению, но постоянно какие-то ошибки.. 
        .Close True 'save changes
      End With
    End If
  Next
  .Quit
End With
wscript.echo "Обработано документов " & numDocs

Как его вставить сюда, чтоб так убрать по всем файлам в папке?

пс: не ожидал что это такой большой сложный макрос. я думал тут буквально несколько строчек, типа поиск текста, если найден снести всю первую страницу..

[shanemac51]

2 ключевых слова занимают только часть ячейки таблицы, а запробелить надо всю ячейку

через регулярные выражения --проще не будет

перебор файлов --конечно возможен, но для начала надо убедится в работоспособности макроса на все 100

действо то опасное

может в других шаблонах
--другие ключевые слова
--другая разбивка на разделы
причем шаблоны Консультанта помечены ---только для чтения, надо и это учитывать

[Karyuudo]

пробовал соединить эти 2 скрипта, оказалось один vba а другой vbs теперь понятно почему не работает

в общем спасибо огромное за макрос, при помощи другого способа обработал им множество файлов все ОК