Solved: Find and format text surrounded by certain characters

[eed]

Hi, y'all,

I am running a procedure from Access that dumps a bunch of database content into Word and formats it into a structured document. Access 2003 can't natively do rich-text formatting inside a field, so users have typed tags around certain strings of text in the fields, e.g., "<b>Make this text bold</b>."

Of course, this won't automatically come out as actual formatting in Word, because Word sees these as simple character strings, not HTML formatting. So what I need is this: once all the text is in Word, I want to find and format as bold any text string that starts with the characters "<b>" and ends with the characters "</b>."

What would be the most efficient way for me to find and format all strings of text that start and end with those characters? Or is there a better way to go about this?

Thanks for any and all help! :)

~ eed

[mdmackillop]

This should make the text bold and delete the formatting characters
Option Explicit
Sub MakeBold()
Dim arr()
Dim i As Long, j As Long
ReDim arr(1, 50)
Selection.HomeKey Unit:=wdStory
Do
Selection.Find.Text = "<b>"
Selection.Find.Execute
If Len(Selection) = 1 Then Exit Do
arr(0, i) = Selection.Start
Selection.Move wdCharacter, 1

Selection.Find.Text = "</b>"
Selection.Find.Execute
arr(1, i) = Selection.Start
Selection.Move wdCharacter, 1

i = i + 1
Loop
ReDim Preserve arr(1, i - 1)
With ActiveDocument
For j = i - 1 To 0 Step -1
.Range(Start:=arr(1, j), End:=arr(1, j) + 4).Delete
.Range(Start:=arr(0, j), End:=arr(0, j) + 3).Delete
.Range(Start:=arr(0, j), End:=arr(1, j)).Bold = True
Next
End With
End Sub

[eed]

Thanks, md! That sounds like it should do just what I need. I will try it out first thing on Monday and then let you know if I have any follow-up questions or else close this thread.

Thanks again!! :thumb
~ eed

[fumei]

Very very cute Malcolm. Impressive. Slick.

I am trying hard to improve it....and I can't so far.

Bravo. As they say...that's a keeper. I have moved it into my master code template, and added it as an example in my Word VBA course document. Duly credited of course.

I did, however, use a With statement for the Selection instructions.
Do
With Selection
.Find.Text = "<b>"
.Find.Execute
If Len(Selection) = 1 Then Exit Do
arr(0, i) = Selection.Start
.Move wdCharacter, 1

.Find.Text = "</b>"
.Find.Execute
arr(1, i) = Selection.Start
.Move wdCharacter, 1
End With
i = i + 1
Loop

[mdmackillop]

Thanks Gerry.
Only thing I considered adding was error handling; a way to check for a missing term. Possibly check all the starts first, then all the ends. I'll give it a bit of thought.

[eed]

Thanks, md, that worked brilliantly! I've modified the procedure slightly to also replace <i>...</i> with italic formatting and <u>...</u> with a single underline, and I've added some error-handling for my application, but I'm including your credit for the original code. Thanks a million, this is really helpful!
~ eed

[fumei]

You could adjust the procedure to accept inputs.
Sub MatchToTags(strStart As String, _
strEnd As String)
Dim arr()
Dim i As Long, j As Long
ReDim arr(1, 50)
Selection.HomeKey Unit:=wdStory
Do
Selection.Find.Text = strStart
Selection.Find.Execute
If Len(Selection) = 1 Then Exit Do
arr(0, i) = Selection.Start
Selection.Move wdCharacter, 1

Selection.Find.Text = strEnd
Selection.Find.Execute
arr(1, i) = Selection.Start
Selection.Move wdCharacter, 1

i = i + 1
Loop
ReDim Preserve arr(1, i - 1)
Select Case strStart
Case "<b>"
With ActiveDocument
For j = i - 1 To 0 Step -1
.Range(Start:=arr(1, j), End:=arr(1, j) + 4).Delete
.Range(Start:=arr(0, j), End:=arr(0, j) + 3).Delete
.Range(Start:=arr(0, j), End:=arr(1, j)).Bold = True
Next
End With
Case "<i>"
With ActiveDocument
For j = i - 1 To 0 Step -1
.Range(Start:=arr(1, j), End:=arr(1, j) + 4).Delete
.Range(Start:=arr(0, j), End:=arr(0, j) + 3).Delete
.Range(Start:=arr(0, j), End:=arr(1, j)).Italics = True
Next
End With
End Select



Then you could use:Sub FixStuff()
Dim StartLetter As String
Dim OpenTag As String
Dim CloseTag As String
StartLetter = InputBox("Enter tag - no brackets. Eg. b, or i")
OpenTag = "<" & StartLetter & ">"
CloseTag = "<\" & StartLetter & ">"
Call MatchToTags(OpenTag, CloseTag)
End SubNow just type "b", or "i", and the procedure will generate the tags strings, and determine what font attribute to use.