1

Тема: Парсинг контента Word (из doc или docx файла) в lotus.

Чтение содержимого ячейки таблицы с word с doc файла.

Данный скрипт читает word  файл "Письмо2.doc"  и в  st  заносит первую ячейку каждой таблицы.
Выводит "1111" и "5555"

Sub Click(Source As Button)
    Dim WordApp As Variant
    Dim worddoc  As Variant
    Dim wObj As Variant
    
    Dim rngToSearch As Variant
    
    
    Set WordApp = CreateObject ("Word.Application")
    Set worddoc = WordApp.Documents.Open("C:\XML\Письмо2.doc",False)    
    Print    worddoc.Tables.Count
    Forall tbl In worddoc.Tables
        st =  tbl.Rows(1).Cells(1).range.text
        Msgbox Cstr(st )        
    End Forall
    'st = worddoc.Tables(1).Rows(1).Cells(1).range.text
    
End Sub
Post's attachments

Word_table.jpg, 13.51 kb, 912 x 212
Word_table.jpg 13.51 kb, 67 downloads since 2016-07-28 

Поделиться

2

Re: Парсинг контента Word (из doc или docx файла) в lotus.

Если есть соединенные ячейки, то обращаемся к содержимому так:

st =  tbl.Cell(1,1).range.text

Поделиться

3

Re: Парсинг контента Word (из doc или docx файла) в lotus.

Проход по всем параграфам документа.

    st =worddoc.Paragraphs.Count 
    Set Par =worddoc.Paragraphs
    Forall xxx In Par
        Msgbox Cstr(xxx.range.text)        
    End Forall

Поделиться

4

Re: Парсинг контента Word (из doc или docx файла) в lotus.

Проход по секциям документа

    For i = 1 To worddoc.Sections.Count
        Set xxx = worddoc.Sections(i).Range
        Msgbox Cstr(xxx.text)
    Next

Поделиться

5

Re: Парсинг контента Word (из doc или docx файла) в lotus.

Ищем закладки в документе.

Msgbox Cstr(worddoc.Bookmarks.Count)

Так же есть объект "FormFields" - поля на форме.

For i = 1 To ActiveDocument.FormFields.Count
MsgBox ActiveDocument.FormFields(i).Name
Next

Поделиться

6

Re: Парсинг контента Word (из doc или docx файла) в lotus.

Чтение в лотусе содержимого word текста между двумя закладками.
Кстати, вместо закладок можно было использовать метод GoToEditableRange.

Sub Click(Source As Button)
    Dim WordApp As Variant
    Dim worddoc  As Variant
    Dim wObj As Variant
    
    Dim rngToSearch As Variant
    
    Set WordApp = CreateObject ("Word.Application")
    Set worddoc = WordApp.Documents.Open("C:\XML\Письмо.docx",False)    
    WordApp.Visible=True
    
    'Msgbox Cstr(worddoc.Bookmarks.Count)
    Set Bookmark = worddoc.Bookmarks
    
    mStart% = Bookmark(1).Range.Start
    mEnd%= Bookmark(2).Range.End
    
    Set myRange = worddoc.Range(  mStart%,mEnd%   )
    Msgbox Cstr(myRange.text)
    
    
End Sub

Поделиться

7

Re: Парсинг контента Word (из doc или docx файла) в lotus.

В диапазоне myRange разбиваем текст на параграфы.

sText$ = ""
Set Par =myRange.Paragraphs
Forall xxx In Par
sText$   = sText$ + {<p>} + Cstr(xxx.range.text)        + {</p>}
End Forall

Поделиться

8

Re: Парсинг контента Word (из doc или docx файла) в lotus.

Выделяем весь текст docx в документе и выводим его в Msgbox.

Sub Click(Source As Button)
    
    Dim worddoc As Variant
    Dim WordApp As Variant
    Dim rnsg As Variant
    
    Set WordApp = CreateObject ("Word.Application")
    WordApp.Visible=False
    mypatch$ = "C:\XML\123.docx"
    Set worddoc = WordApp.Documents.Open(mypatch$)    
    worddoc.Select
    
    Set myRange = worddoc.Content
    Msgbox Cstr(myRange.Text)
    
    worddoc.Close
    WordApp.Quit
    
End Sub

Поделиться

9

Re: Парсинг контента Word (из doc или docx файла) в lotus.

Помечаем жирные слова в тексте.

Sub Click(Source As Button)
    Dim ws As New NotesUIWorkspace
    Dim udoc As NotesUIDocument
    Set udoc = ws.CurrentDocument
    Dim doc As NotesDocument
    Set doc = udoc.Document
    
    Dim worddoc As Variant
    Dim WordApp As Variant
    Set WordApp = CreateObject ("Word.Application")
    WordApp.Visible=False
    mypatch$ = "C:\XML\123.docx"
    Set worddoc = WordApp.Documents.Open(mypatch$)    
    worddoc.Select
    
    Set myRange = worddoc.Content
    'Msgbox Cstr(myRange.Text)    
    
    Forall  slovo In worddoc.Words
        If slovo.Font.Bold = True Then
            Print slovo.text  & " жирно"
        End If
        
    End Forall
    
    '    For i% = 1 To Len(myRange.Text)
    '        xxx = worddoc.Range (i%,i%+1).Text
    '        Print  Cstr(xxx)
    '    Call rtitem.AppendText (Cstr(xxx))
    '    Next
    
    
    worddoc.Close
    WordApp.Quit
    Call doc.Save( False, True )
    Call udoc.Close
End Sub

Поделиться

10

Re: Парсинг контента Word (из doc или docx файла) в lotus.

То же самое, пытаемся выделить жирное слово тегами.

Dim Slovo As String



For i = 1 To ActiveDocument.Range.Words.Count
 Slovo = ActiveDocument.Words.Item(i)

  If ActiveDocument.Words.Item(i).Font.Bold = True Then
ActiveDocument.Words.Item(i) = "<b>" & ActiveDocument.Words.Item(i) & "</b>"

Selection.EndOf
End If
Next

Еще попытка неудачная.

'For Each Slovo In ActiveDocument.Words
'If Slovo.Font.Size = 14 Then
Slovo.InsertAfter ("***")
End If
Next

Поделиться

11

Re: Парсинг контента Word (из doc или docx файла) в lotus.

Удачный результат на VBA для помечания тегом <b> - жирным шрифтом слов и букв.

Sub Слово_буквы_жирн()

  On Error GoTo ErrHandler:
  
 Set Bookmark = ActiveDocument.Bookmarks
 mStart% = Bookmark(1).Range.Start
 mEnd% = Bookmark(2).Range.End
 Dim myRange As Range
 Set myRange = ActiveDocument.Range(mStart%, mEnd%)
 Dim slovo As Word.Range
 Dim bukva As Word.Range

    Set objWords = myRange.Words 'ActiveDocument.Words
    
    For iCount = objWords.Count To 1 Step -1
    Set slovo = objWords(iCount)
    Debug.Print Asc(slovo.Text)
     
    If Asc(slovo.Text) = 13 Then
     Debug.Print "спецсимвол"
    Else
      If slovo.Bold = True Then
      slovo.Text = "<B>" & Trim$(slovo.Text) & "</B> "
      Else
        For xCount = slovo.Characters.Count To 1 Step -1
        Set bukva = slovo.Characters(xCount)
        If bukva.Bold = True Then
        bukva.Text = "<B>" & Trim$(bukva.Text) & "</B>"
        End If
        Next
      End If
        
      End If
    Next
    Exit Sub
ErrHandler:
MsgBox Err.Number
    Resume Next
End Sub

Этот же код уже на лотус скприте:

Sub Click(Source As Button)
    Dim ws As New NotesUIWorkspace
    Dim udoc As NotesUIDocument
    Set udoc = ws.CurrentDocument
    Dim doc As NotesDocument
    Set doc = udoc.Document
    
    Dim worddoc As Variant
    Dim WordApp As Variant
    Set WordApp = CreateObject ("Word.Application")
    WordApp.Visible=False
    mypatch$ = "C:\XML\123.docx"
    Set worddoc = WordApp.Documents.Open(mypatch$)    
    worddoc.Select
    
    Set objWords = worddoc.Words
    For iCount = objWords.Count To 1 Step -1
        Set slovo = objWords(iCount)
        If slovo.Bold = True Then
            Print "slovo " & slovo.Text 
            slovo.Text = "<B>" & Trim$(slovo.Text) & "</B> "
        Else
            For xCount = slovo.Characters.Count To 1 Step -1
                Set bukva = slovo.Characters(xCount)
                If bukva.Bold = True Then
                    Print "bukva " & slovo.Text 
                    bukva.Text = "<B>" & Trim$(bukva.Text) & "</B>"
                End If
            Next
            
        End If
    Next
    
    worddoc.Close
    WordApp.Quit
    Call doc.Save( False, True )
    Call udoc.Close
End Sub

Был текст в ворде:

Слово1     слово2       слово3
Жирное слово
нежирное

Стал такой текст:

Слово1     с<B>л</B>ово2       слово3
<B>Жирное</B> <B>слово</B>
нежирное

Поделиться

12

Re: Парсинг контента Word (из doc или docx файла) в lotus.

А это более сложный вариант обрамления тегом <B> жирны слов и символов

    mStart% = Bookmark(1).Range.Start    '  WORD ТЕКСТ
    mEnd%= Bookmark(2).Range.End
    Print mStart% 
    Print mEnd%
    Set myRange = worddoc.Range(  mStart%,mEnd%   )
    
    'objWords = myRange.Words ' ЖИРНЫЙ ШРИФТ <B>
    Print "Слов в Word тексте: "  & Cstr(worddoc.Words.Count )
    Print "Слов Word в myRange: "  & Cstr(myRange.Words.Count )
    For iCount = myRange.Words.Count To 1 Step -1
    '    Print "iCount " &  iCount
        Set slovo = myRange.Words(iCount)
        If  Asc(slovo.Text) = 13 Then
            Print "плохой символ"
        Else
            If slovo.Bold = True Then
                Print "slovo " & slovo.Text 
                slovo.Text = "<b>" & Trim$(slovo.Text) & "</b> "
            Else
                For xCount = slovo.Characters.Count To 1 Step -1
                    Set bukva = slovo.Characters(xCount)
                    If bukva.Bold = True Then
                        Print "bukva " & slovo.Text 
                        bukva.Text = "<b>" & Trim$(bukva.Text) & "</b>"
                    End If
                Next
            End If
        End If
        
    Next

Поделиться

13

Re: Парсинг контента Word (из doc или docx файла) в lotus.

А вот макрос на визуал бейсике, который делает замену жирности на основе земены и регулярного выражения.

Sub test()
'

    Selection.Find.ClearFormatting
    Selection.Find.Font.Bold = True
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(<*>)"
        .Replacement.Text = "<b>\1</b>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Макрос сделан на основе автозамены в ворде.
Найти: (<*>)
Заменить: <b>\1</b>

Post's attachments

Найти и заменить.JPG, 47.97 kb, 581 x 450
Найти и заменить.JPG 47.97 kb, 37 downloads since 2017-01-24 

Поделиться

14

Re: Парсинг контента Word (из doc или docx файла) в lotus.

Замена жирных символов и слов на лотусскрипте. Почему-то не работает.

Set myRange = worddoc.Range(  mStart%,mEnd%   )
    
    Dim rngResult As Variant
    
    Set rngResult  = myRange.Duplicate  ' клонирует имеющийся текстовый диапазон
    rngResult.Find.ClearFormatting ' очищает форматирование внутри объекта Find 
    rngResult.Find.Font.Bold = True
    rngResult.Find.Replacement.ClearFormatting   ' Сброс форматирования из предыдущих операций поиска.
    
    rngResult.Find.Text = "(<*>)"
    rngResult.Find.Replacement.Text = "<b>\1</b>"  ' на что заменяем
    rngResult.Find.Forward = True ' поиск по всему документу вперед
    rngResult.Find.Wrap = wdFindContinue ' продолжать поиск, если анчали не с  начала документа
    rngResult.Find.Format = True ' включить форматирование
    rngResult.Find.MatchCase = False ' не учитывать регистр
    rngResult.Find.MatchWholeWord = False ' искать части слов
    rngResult.Find.MatchAllWordForms = False ' учитывать словоформы
    rngResult.Find.MatchSoundsLike = False  ' учитывать похожие слова
    rngResult.Find.MatchWildcards = True '  подстановочные знаки - флажок в (Edit menu) ворда
    
    rngResult.Find.Execute

Этот код тоже не работает ((

Sub Click(Source As Button)
    Dim ws As New NotesUIWorkspace
    Dim udoc As NotesUIDocument
    Set udoc = ws.CurrentDocument
    Dim doc As NotesDocument
    Set doc = udoc.Document
    
    Dim worddoc As Variant
    Dim WordApp As Variant
    Set WordApp = CreateObject ("Word.Application")
    WordApp.Visible=False
    mypatch$ = "C:\XML\123.docx"
    Set worddoc = WordApp.Documents.Open(mypatch$)    
    worddoc.Select
    Set myRange = worddoc.Content
    Msgbox Cstr(myRange.Text)
    
    myRange.Find.Text = "b"
    myRange.Find.Replacement.Text = "<b>"
    myRange.Find.ClearFormatting ' очищает форматирование внутри объекта Find 
    'myRange.Find.Font.Bold = True
    myRange.Find.Replacement.ClearFormatting   ' Сброс форматирования из предыдущих операций поиска.
    myRange.Find.Forward = True ' поиск по всему документу вперед
    myRange.Find.Wrap = wdFindContinue ' продолжать поиск, если анчали не с  начала документа
    myRange.Find.Format = True ' включить форматирование
    myRange.Find.MatchCase = False ' не учитывать регистр
    myRange.Find.MatchWholeWord = False ' искать части слов
    myRange.Find.MatchAllWordForms = False ' учитывать словоформы
    myRange.Find.MatchSoundsLike = False  ' учитывать похожие слова
    'myRange.Find.MatchWildcards = True '  подстановочные знаки - флажок в (Edit menu) ворда
    myRange.Find.Execute ,,,,,,,,, wdReplaceAll
    Msgbox Cstr(myRange.Text)
    myRange.Text = "===="
    
    
    'Dim myList  List As String
    'myList  ("b") = "<b>"
    'myList  ("1") = "<1>"
    'xxxxxxxxxx = ReplaceByTemplate(myList , worddoc) 
    
    worddoc.Close
    WordApp.Quit
    Call doc.Save( False, True )
    Call udoc.Close
End Sub

Поделиться

15

Re: Парсинг контента Word (из doc или docx файла) в lotus.

Макрос замены жирности в нужном нам диапазоне между закладками.

Sub Jirno()
'
'
On Error GoTo ErrHandler:

Set Bookmark = ActiveDocument.Bookmarks
 mStart% = Bookmark(1).Range.Start + 1
 mEnd% = Bookmark(2).Range.End - 2
 
Dim myRange As Range
 Set myRange = ActiveDocument.Range(mStart%, mEnd%)
  myRange.Select
  


  'Selection.InsertAfter "РАБОТАЕТ ДОБАВЛЕНИЕ ТЕКСТА"  
  
    Selection.Find.ClearFormatting
    Selection.Find.Font.Bold = True
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(<*>)"
        .Replacement.Text = "<b>\1</b>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll  ' работает
    
        Exit Sub
ErrHandler:
MsgBox Err.Number
    Resume Next
End Sub

Поделиться

16

Re: Парсинг контента Word (из doc или docx файла) в lotus.

Замена корректно работает посимвольно при таком варианте:
Найти: (?)
Заменить на: <b>/1</b>

Поделиться

17

Re: Парсинг контента Word (из doc или docx файла) в lotus.

Вот еще вариант замены на жирность для больших текстов.

Sub TEGHTML2()
'
' TEGHTML2 Макрос

  Selection.WholeStory
    Selection.GoToEditableRange (wdEditorEveryone)
    Selection.GoToEditableRange (wdEditorEveryone)
    Selection.GoToEditableRange (wdEditorEveryone)
    Selection.GoToEditableRange (wdEditorEveryone)
    
    Selection.Find.ClearFormatting
    Selection.Find.Font.Bold = True
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(?)"
        .Replacement.Text = "<b>\1</b>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll  ' работает
    
End Sub

Поделиться

18

Re: Парсинг контента Word (из doc или docx файла) в lotus.

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

Поделиться

19

Re: Парсинг контента Word (из doc или docx файла) в lotus.

Вывод оказался неверным. Просто часть символов, типа кавычек и скобок разных - не отображается в html .

Правильный макрос для добавления тегов жирности тексту.

Sub TEGJirno()
On Error GoTo ErrHandler:
Set Bookmark = ActiveDocument.Bookmarks
mStart& = Bookmark(1).Range.Start + 1
mEnd& = Bookmark(2).Range.End - 2
    
Dim myRange As Range
Set myRange = ActiveDocument.Range(mStart&, mEnd&)
myRange.Select

    Selection.Find.ClearFormatting
    Selection.Find.Font.Bold = True
     Selection.Find.Replacement.Text = "<b>^&<b>" 'это теги bold-выделений
    Selection.Find.Replacement.Font.Bold = False 'это убор bold-выделений из Word
    Selection.Find.Execute FindText:="", Replace:=wdReplaceAll, Wrap:=wdFindContinue
    
            Exit Sub
ErrHandler:
MsgBox Err.Number
    Resume Next
End Sub

Но при варианте последовательного запуска макросов
Call     WordApp.Run ("ReplHTML") ' замена тегов на html символы
Call     WordApp.Run ("TEGJirno")  ' всё жирное окружается тегами <b> </b>
и окружении жирным двух и более параграфов, получается
<p>
<b> внутри другие невалидные теги -   </p><p> .... </b> - что невалидно для xml.
</p>

Пример:

<p> ляляля
<b>б) с. Парканы,;</p><p><span style="padding:0px 10px;"></span>в) с. Фрунзе, ул. Советская, 7 (ОС Фрунзе);</p><p><span style="padding:0px 10px;"></span>г) пос. Красное, ул. 40 лет Октября, дом 7 (ОС Красное);</p><p><span style="padding:0px 10px;"></span></b>
пам пам </p>

Поделиться

20

Re: Парсинг контента Word (из doc или docx файла) в lotus.

Была проблема - если большой документ ворд, то при копировании в буфер и закрытии ворда было окошко  "Буфер обмена содержит большой текстовый фрагмент".
Очищаю буфер в лотусе:
WordApp.WordBasic.EditOfficeClipboard

Post's attachments

Буфер ворда очистить VBA.JPG, 25.73 kb, 875 x 165
Буфер ворда очистить VBA.JPG 25.73 kb, 36 downloads since 2017-03-01 

Поделиться

21

Re: Парсинг контента Word (из doc или docx файла) в lotus.

Еще тестовая функция Testword, переходит к разделу ворд файла с обращением к руководителю, закидывает текст в обычную лотусовую текстовую переменную, обрамляет обращение <p align="center">  ... </p>"

Function Testword (worddoc) As textandsign' абзацы с красной строки
    On Error Goto ErrH
    
    Dim slovo As Variant
    Dim sText As String
    Dim sign As String
    
    Dim obtextandsign As New textandsign
    
    Set Bookmark = worddoc.Bookmarks
    Print "Закладок: " & Cstr(worddoc.Bookmarks.Count)
    If worddoc.Bookmarks.Count  <> 4 Then
        Messagebox "Некорректный файл с word шаблоном!"
        worddoc.Close
        Exit Function
    End If
    
    sText   =  "текст"
    
    worddoc.Selection.GoToEditableRange (wdEditorEveryone)
    worddoc.Selection.GoToEditableRange (wdEditorEveryone)
    worddoc.Selection.GoToEditableRange (wdEditorEveryone)
    worddoc.Selection.GoToEditableRange (wdEditorEveryone)
    worddoc.Selection.GoToEditableRange (wdEditorEveryone)
    sText   =  worddoc.Selection.text
    Messagebox sText
    
    sAppeal$ = sText
    sAppeal$   =  Strclean (sAppeal$)
    sText   =   |<p align="center">| + sAppeal$  + "</p>"+ sText
    
    mStart% = Bookmark(2).Range.Start     '  Подпись  руководителя
    mEnd%= Bookmark(4).Range.End
    Set myRange = worddoc.Range(  mStart%,mEnd%   )
    sign = Cstr(myRange.text)
    sign   =  Strclean (sign)       
    
    obtextandsign.obText =  sText 
    obtextandsign.obSign = sign
    Set    Testword = obtextandsign
    
    worddoc.Close
    
    Exit Function
ErrH:
    Print "Ошибка ф-ции  TeStword  " & Error(Err) & " в строке " & Erl    
    
End Function

Поделиться