Finding and adding to Underlined Words in VBA Word - vba

Question

I was looking to see if it was possible to create a macro that locates underlined words in a word document and converts them to the html tags. i tried to record a macro to do that but it just adds tags to all words. I also provide some of the code i tried to use:
Dim myWords() As String
Dim i As Long
Dim myDoc As Document: Set myDoc = ActiveDocument ' Change as needed
Dim aRange As Range: Set aRange = myDoc.Content
Dim sRanges As StoryRanges: Set sRanges = myDoc.StoryRanges
Dim ArrayCounter As Long: ArrayCounter = 0 ' counter for items added to the array
Dim Sentence As Range
Dim w As Variant
Application.ScreenUpdating = False
ReDim myWords(aRange.Words.Count) ' set a array as large as the
' number of words in the doc
For Each Sentence In myDoc.StoryRanges
For Each w In Sentence.Words
If w.Font.Underline <> wdUnderlineNone Then
myDoc.Sentence.Range.InsertBefore "<u>"
myDoc.Sentence.Range.InsertAfter "</u>"
End If

Answer 1

Well this code looks familiar!
Here's a tweak on what you've done that should add the tag around each underlined word. It's important to note, you must remove the underline property, and then add the tag. Otherwise word will treat the newly introduced tag as a new word, and repeat the process.
Sub ChangeUnderLineToHTML()
Dim myDoc As Document: Set myDoc = ActiveDocument ' Change as needed
Dim aRange As Range: Set aRange = myDoc.Content ' Change as needed
Dim sRanges As Variant: Set sRanges = myDoc.StoryRanges
Dim sentence As Object
Dim w As Object
For Each sentence In sRanges
For Each w In sentence.Words
If w.Font.Underline <> wdUnderlineNone Then
w.Font.Underline = wdUnderlineNone
w.Text = "<u>" & w.Text & "</u>"
End If
Next w
Next sentence
'Clean Up
Set myDoc = Nothing
Set aRange = Nothing
Set sRanges = Nothing
Set w = Nothing
Set sentence = Nothing
End Sub