Word macro to add html tags to specific parsed phrases

Hi Guys,

I have a text file that contains over eight thousand of multiple choice questions each is followed by an empty paragraph to separate it from the following question, as per the following example:

Type: MC
1) What is the effect of releasing a ball in positive gravity?
~ It will fall down. (This is the correct answer) It will retain its mass. (This answer is true but unrelated) It will rise. (This answer is false but related) Its shape will change. (This answer is false and unrelated) It will explode. (This answer is false and unrelated)
@ IncorrectIt will fall down. (This is the correct answer) It will retain its mass. (This answer is true but unrelated) It will rise. (This answer is false but related) Its shape will change. (This answer is false and unrelated) It will explode. (This answer is false and unrelated)
*a. It will fall down
b. It will retain its mass
c. It will rise
d. Its shape will change
e. It will explode

I'm requested to edit this file by changing the colour of all the items in the two paragraphs that start with "Tilde ~" and "Ampersand @" as long as these phrases exist in the list of alternative answers "a. – k.". In other words to parse the list of alternative answers for each question (in my example a. to e.), and only change their corresponding phrases in the above two paragraphs that start with "~" and "@", by adding relevant html tags. Thus each question will become as follows:

Type: MC
1) What is the effect of releasing a ball in positive gravity?
~ <font color = "#008000">It will fall down</font>. (This is the correct answer) <font color = "#008000">It will retain its mass</font>. (This answer is true but unrelated) <font color = "#008000">It will rise</font>. (This answer is false but related) <font color = "#008000">Its shape will change</font>. (This answer is false and unrelated) <font color = "#008000">It will explode</font>. (This answer is false and unrelated)
@ <font color = "#008000">It will fall down</font>. (This is the correct answer) <font color = "#008000">It will retain its mass</font>. (This answer is true but unrelated) <font color = "#008000">It will rise</font>. (This answer is false but related) <font color = "#008000">Its shape will change</font>. (This answer is false and unrelated) <font color = "#008000">It will explode</font>. (This answer is false and unrelated)
*a. It will fall down
b. It will retain its mass
c. It will rise
d. Its shape will change
e. It will explode

.. another question

.. another question

Can someone help with this request please? Many thanks in advance.

Interesting challenge. The following code is based on the structure you have defined and tested only on a small sample of text. It requires that each set (the question type, question, ~ text, @ text, and answers each consist of a single paragraph. So in your example the set is 9 paragraphs total. Each set is delimited from the other sets by a empty paragraph:

Code:

---

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim lngIndex As Long
Dim strFind As String
Dim oRng As Word.Range
Dim oRngBox As Word.Range
Dim oSrchRng As Word.Range
  Set oRng = ActiveDocument.Range
  oRng.Collapse wdCollapseStart
  Do
    Do
      On Error Resume Next
      oRng.MoveEnd wdParagraph
      If Err.Number <> 0 Then Exit Do
    Loop Until oRng.Characters.Last.Next = Chr(13)
    On Error GoTo 0
    For lngIndex = 5 To oRng.Paragraphs.Count
      strFind = oRng.Paragraphs(lngIndex).Range.Text
      strFind = Right(strFind, Len(strFind) - InStr(strFind, ".") - 1)
      strFind = Left(strFind, Len(strFind) - 1)
      Set oSrchRng = oRng.Paragraphs(3).Range
      Set oRngBox = oSrchRng.Duplicate
      Selection.Find.ClearFormatting
      With oSrchRng.Find
        .Text = strFind
        While .Execute
          If oSrchRng.InRange(oRngBox) Then
            With oSrchRng
              If oSrchRng.Characters.Last.Next = "." Then oSrchRng.MoveEnd wdCharacter, 1
              .InsertBefore "<font color = ""#008000"">"
              .InsertAfter "</font>"
              .Collapse wdCollapseEnd
            End With
          End If
        Wend
      End With
      Set oSrchRng = oRng.Paragraphs(4).Range
      With oSrchRng.Find
        .Text = strFind
        While .Execute
          If oSrchRng.InRange(oRngBox) Then
            With oSrchRng
              If oSrchRng.Characters.Last.Next = "." Then oSrchRng.MoveEnd wdCharacter, 1
              .InsertBefore "<font color = ""#008000"">"
              .InsertAfter "</font>"
              .Collapse wdCollapseEnd
            End With
          End If
        Wend
      End With
    Next lngIndex
    oRng.Collapse wdCollapseEnd
    oRng.MoveStart wdParagraph, 1
  Loop Until oRng.End = ActiveDocument.Range.End - 1
End Sub

---

Please visit my website: http://gregmaxey.mvps.org/word_tips.html

Fabulous, really genius code Greg, I'm really stunned as I ran the code and it did what is expected. Nevertheless, there three things still pending:
1. the code does change relevant texts in the paragraph that starts with ampersand, but it totally ignores the second paragraph that starts with tilde, accordingly no change happens on it.
2. when running the code on questions with long alternatives (over 40 words per alternative), the code halts on line 19 where "." is, with a message "parameter too long".
3. can we make the right answer distinctive by giving it a different colour such as #1A06FB, keeping the rest of items in colour #008000? The right answer is always marked with an * before the letter of its item; in my example it is item "a." (*a.)

I'm more than appreciating for your input to this matter; really I don't know how to thank you.

mpeterson,

1) It looks like I forgot to add "Set oRngBox = oSrchRng.Duplicate" immediately after "Set oSrchRng = Set oSrchRng = oRng.Paragraphs(4).Range
2) This is a problem. It should be failing on the line .Text = strFind because the string length of that parameter is limited to 255 characters. I think the best I could do gratis is hightlight those instances and hopefully there are not a lot of them. You can then go back and add the closing tag.
3. Sure

Code:

---

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim lngIndex As Long
Dim strFind As String
Dim oRng As Word.Range
Dim oRngBox As Word.Range
Dim oSrchRng As Word.Range
Dim bCorrect As Boolean, bTooLong As Boolean
  Set oRng = ActiveDocument.Range
  oRng.Collapse wdCollapseStart
  Do
    Do
      On Error Resume Next
      oRng.MoveEnd wdParagraph
      If Err.Number <> 0 Then Exit Do
    Loop Until oRng.Characters.Last.Next = Chr(13)
    On Error GoTo 0
    For lngIndex = 5 To oRng.Paragraphs.Count
      bCorrect = False
      bTooLong = False
      strFind = oRng.Paragraphs(lngIndex).Range.Text
      If Left(strFind, 1) = "*" Then bCorrect = True
      strFind = Right(strFind, Len(strFind) - InStr(strFind, ".") - 1)
      strFind = Left(strFind, Len(strFind) - 1)
      Set oSrchRng = oRng.Paragraphs(3).Range
      Set oRngBox = oSrchRng.Duplicate
      Selection.Find.ClearFormatting
      With oSrchRng.Find
        If Len(strFind) > 255 Then bTooLong = True
        If Not bTooLong Then
          .Text = strFind
          While .Execute
            If oSrchRng.InRange(oRngBox) Then
              With oSrchRng
                If oSrchRng.Characters.Last.Next = "." Then oSrchRng.MoveEnd wdCharacter, 1
                If bCorrect Then
                  .InsertBefore "<font color = ""#1A06FB"">"
                Else
                  .InsertBefore "<font color = ""#008000"">"
                End If
                .InsertAfter "</font>"
                .Collapse wdCollapseEnd
              End With
            End If
          Wend
        Else
          .Text = Left(strFind, 255)
          While .Execute
            If oSrchRng.InRange(oRngBox) Then
              With oSrchRng
                If bCorrect Then
                  .InsertBefore "<font color = ""#1A06FB"">"
                Else
                  .InsertBefore "<font color = ""#008000"">"
                End If
                .HighlightColorIndex = wdYellow
                .Collapse wdCollapseEnd
              End With
            End If
          Wend
        End If
      End With
      Set oSrchRng = oRng.Paragraphs(4).Range
      Set oRngBox = oSrchRng.Duplicate
      With oSrchRng.Find
        If Len(strFind) > 255 Then bTooLong = True
        If Not bTooLong Then
          .Text = strFind
          While .Execute
            If oSrchRng.InRange(oRngBox) Then
              With oSrchRng
                If oSrchRng.Characters.Last.Next = "." Then oSrchRng.MoveEnd wdCharacter, 1
                If bCorrect Then
                  .InsertBefore "<font color = ""#1A06FB"">"
                Else
                  .InsertBefore "<font color = ""#008000"">"
                End If
                .InsertAfter "</font>"
                .Collapse wdCollapseEnd
              End With
            End If
          Wend
        Else
          .Text = Left(strFind, 255)
          While .Execute
            If oSrchRng.InRange(oRngBox) Then
              With oSrchRng
                If bCorrect Then
                  .InsertBefore "<font color = ""#1A06FB"">"
                Else
                  .InsertBefore "<font color = ""#008000"">"
                End If
                .HighlightColorIndex = wdYellow
                .Collapse wdCollapseEnd
              End With
            End If
          Wend
        End If
      End With
    Next lngIndex
    oRng.Collapse wdCollapseEnd
    oRng.MoveStart wdParagraph, 1
  Loop Until oRng.End = ActiveDocument.Range.End - 1
End Sub

---

Magnificent Greg. It is working like magic. Please accept my deep respect and gratitude. Thank you.

It was fun. Glad I could help. As for the thanks, do they not brew beer anymore in Australia? You can buy me one next time I'm over.

You're welcome any time "mate" :)

Dear Greg,
Over two years ago, I requested help in this thread and you generously and professionally provided it. Since then, I have been using your code which did a lot of work for me.
Due to the increasing amount of work needed by this code, manual work of running it on a file and saving it has become a very tedious and time consuming task. The number of files that need html tags application is over 15000!!
I was thinking, if it is possible, to automate running your code by another code that does the following:
1. Opens one file.doc at a time from "c:\before_conversion" folder,
2. Runs your masterpiece code to apply html tags,
3. Saves the converted file in the same name but in another folder named "c:\after_conversion", and
4. Goes for the following file in "before_conversion" folder to do the same three processes till the end of all files in this folder.

I actually preferred asking you first, simply because I know who is Greg Maxey, and it is only you who'd tell me to post it on a new thread.

Very much appreciated.

mpeterson,

Certainly possible. I'm headed out for the day but take a look at my http://gregmaxey.com/word_tip_pages/...der_addin.html which I believe you could apply to your process or if that seems too daunting then just search this group for examples using the Dir function.

Thank you very much for your reply, I will see what I can do.

Always appreciating your assistance. Thank you.