Using VBA to put in HTML tags for bolded, italicized or underlined text

[Pat Parker]

Hi all. I am a novice at VBA who learns by looking at existing VBA code and making small changes to it until I figure out what I need to do. However, I am at an impasse here. I have a problem where I am trying to use VBA code I found online to go through a word doc and put HTML type tags for anything that is bold, underlined, or italic. The problem is that the code has a problem with the outline format of my word doc (see attached with the macro A_Add_HTML_tags contained in it). For example, if you run the macro, the outline section (iii) appears as follows:

Capital structure<i><b>

I want it to appear as follows:
<b><i>Capital structure<i><b>

The other tags that I need are at the end of the preceding line, which doesn't help me. I tried changing .MatchWholeWord to True which somewhat accomplishes what I need, but then every single word has tags. Any advice would be greatly appreciated. VBA code is pasted below:

Sub A_Add_HTML_tags()  ' 1102/16 - should add HTML tags to all word docs in the folder
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
' strFolder = GetFolder
' strFolder = "C:\" ' I added this to override the above line
' If strFolder = "" Then Exit Sub
 'strFile = Dir(strFolder & "\*.doc", vbNormal)
' While strFile <> ""
'  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With ActiveDocument.Range.Find
    .Text = ""
    .Forward = True
'    .Wrap = wdFindStop ' this is from the bold tag macro
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    
    
    .ClearFormatting
    .Font.Bold = True
    .Font.Italic = True
    With .Replacement
      .ClearFormatting
      .Text = "<b><i>^&<i></b>"
      .Font.Bold = False
      .Font.Italic = False
    End With
    .Execute Replace:=wdReplaceAll
    
    
    
    .ClearFormatting
    .Font.Bold = True
    With .Replacement
      .ClearFormatting
      .Text = "<b>^&</b>"
      .Font.Bold = False
    End With
    .Execute Replace:=wdReplaceAll
    .ClearFormatting
    .Font.Italic = True
    With .Replacement
      .ClearFormatting
      .Text = "<i>^&<i>"
      .Font.Italic = False
    End With
    .Execute Replace:=wdReplaceAll
    .ClearFormatting
    .Font.Underline = True
    With .Replacement
      .ClearFormatting
      .Text = "<u>^&<u>"
      .Font.Underline = False
    End With
    .Execute Replace:=wdReplaceAll
  End With
'  wdDoc.Close SaveChanges:=True
'  strFile = Dir()
' Wend
' Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub