Тормоза в VBA при обработке документа Word.

[coshi]

Есть у меня метод такой:

Код: Выделить всё

Sub ProcessWordDoc()
    Dim colWords As New Collection
    Dim objWord As Word.Application
    Dim objDoc As Word.Document
    Set objWord = New Word.Application
    Set objDoc = objWord.Documents.Open(path + "\" + filename)
    For Each wrd In objDoc.Words
        If wrd.Font.Color = 255 Then
            colWords.Add (objDoc.Words(nword))
        End If
    Next
    objDoc.Close True
    objWord.Quit True
    Set objDoc = Nothing
    Set objWord = Nothing
End Sub

Всё это у меня работает внутри макроса в Outlook.
Цель метода - собрать все слова, выделенные красным в ону коллекцию.
В файле вордовском 17 страниц. Вышеизложенный процесс обработки длится около 10 минут, пожирая все ресурсы, причем после завершения метода остается висеть один (из двух! запущенных в коде) процесс winword.exe
Вопрос № 1. Такое пожирание ресурсов - это нормально для vba или здесь что-то не так? (celeron 2000)
Вопрос № 2. Цель моей проги - разбить вордовский файл на несколько, основываясь на выделенных в красный цвет метках. Файл этот вордовский приходит в почте (поэтому всё это есть часть макроса Outlook). Можно ли как-нибудь быстрее распарсить вордовский файл основываясь на метках в его содержимом?

[GSerg]

Интересно, всё-таки что добавляется в коллекцию при colWords.Add (objDoc.Words(nword))?..
По идее range, потому всё и висит, наверное. А может и нет.

Скобки рулят. Когда знаешь, где их ставить. И не рулят в остальных случаях.

colWords.Add objDoc.Words(nword).Text



Насчёт вопроса номер 2... А попробуй

Код: Выделить всё

  With objDoc.Range.Find
    .ClearFormatting
    .Format = True
    .Font.ColorIndex = wdRed
    Do While .Execute(vbNullString, , True)
      colWords.Add .Parent.Text
    Loop
  End With

[alibek]

Интересно, всё-таки что добавляется в коллекцию при colWords.Add (objDoc.Words(nword))?..

С наводки Vi, там скорее всего висит дефолтовая проперть.

[coshi]

да, немного промахнулся.. при вставке кода сюда.
там должно стоять
colWords.Add wrd

[GSerg]

А это ничё не меняет.

[coshi]

этот код сработал довольно быстро, спасибо
буду думать дальше как на основе этой коллекции сам файл разбивать..

[GSerg]

А чё тут думать.

Код: Выделить всё

dim prevpos as long

prevpos=objDoc.Range.start
With objDoc.Range.Find
  .ClearFormatting
  .Format = True
  .Font.ColorIndex = wdRed
  Do While .Execute(vbNullString, , True)
    MsgBox objDoc.Range(prevpos, .Parent.Start).Text
    prevpos = .Parent.End + 1
  Loop
End With
If prevpos < objDoc.Range.End Then MsgBox objDoc.Range(prevpos).Text

[coshi]

Вышеизложеное работает! Спасибо.
Еще есть вопросик по теме.
Мой скрипт в vba в outlook должен обработать вложение (файл word) и пересылать его по папкам. В идеале было бы чтобы лишних обращений к жесткому диску не было вообще.
У меня случай неидеальный - вложение, будучи полученным, сохраняется на жестком диске, после чего загружается в Document и начинается его обработка.
Но теперь получается что каждое из вложений, которые я получаю после обработки файла тоже нужно сохранять на диск, и мне это не нравится
Нельзя ли написать что-нибудь вроде:

Код: Выделить всё

Sub SendLetters(ByVal theme As String, ByVal recipients As String, ByRef attach As Document)
    Dim i As Integer
    Dim eMailItem As MailItem
    Dim DestFolder As MAPIFolder
    Set DestFolder = Session.Folders("folder1")
    Set eMailItem = Application.CreateItem(olMailItem)
    eMailItem.Subject = theme
    eMailItem.Attachments.Add (attach) 'Вот строчка с неправильным синтаксисом.
    eMailItem.Move (DestFolder)
End Sub

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

Код: Выделить всё

Options.SendMailAttach = False
ActiveDocument.SendMail

[GSerg]

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

[coshi]

Сейчас мне нужно вставить текст из вордовского документа как записку (olNoteItem).
проблемы сейчас такие:
1. теряется всё форматирование
2. Поле Subject read-only у noteItem -> оно получается пустым в итоге.
3. В теле записки сначала идёт сначала какой-то ярлык с конвертом, называется "Без имени", потом идет вот это "------------" и только потом содержимое документа word без форматирования.

Вот код:

Код: Выделить всё


            For Each DestFolder In colFolders
                Set eNoteItem = Application.CreateItem(olNoteItem)
                'attach.Kind = wdDocumentEmail
                eNoteItem.Body = attach.Content
                'eNoteItem.Body = attach.Content.FormattedText               
                eNoteItem.Move DestFolder
                Set eNoteItem = Nothing
            Next