Word VBA If Statement Find/Replace text to HTML tags

I have several large documents that I would like to convert to clean HTML in order for me to put the resulting document into my kindle. Now I know Word has a Save as feature to save HTML but the code is very messy even with the filtered option.

I found an excellent piece of code by Greg Maxey that works great. Link here http://ift.tt/1DX4Jmn

However a problem arises when I use the style Heading 1. As Heading 1 has bold text this macro wraps it in strong tags and I want to be able to avoid this and wrap the headings in h1 tags. I thought I could adapt the code to add an IF Statement to check for bold text and if it's a heading then wrap the correct h1 tags else if it is ordinary bold text wrap strong tags around it.

Also I wanted to wrap paragraphs with the p tags but again I would face the same issue. How to I make the code ignore paragraphs containing headers?

I have provided my amended code below and highlighted via comments the amended section. I would be extremely grateful if someone could take a look at this and let me know where I am going wrong.

Many thanks.

Michael

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Word.Range
Dim oStyle As Variant
Set oStyle = ActiveDocument.Styles("Heading 1")
'Replace Bold text
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.MatchWildcards = True
.Format = True
.Font.Bold = True
While .Execute
With oRng
'===Code amended here===
If oRng = oStyle Then
.InsertBefore "<h1>"
.InsertAfter "</h1>"
.Font.Bold = False
.Collapse wdCollapseEnd
Else
'===End of amended code===
.InsertBefore "<strong>"
.InsertAfter "</strong>"
.Font.Bold = False
.Collapse wdCollapseEnd
'===Code amended here===
End If
'===End of amended code===
End With
Wend
End With
'Replace Underlined text
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.MatchWildcards = True
.Format = True
.Font.Underline = True
While .Execute
With oRng
.InsertBefore "<u>"
.InsertAfter "</u>"
.Font.Underline = False
.Collapse wdCollapseEnd
End With
Wend
End With
'Replace Italic text
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.MatchWildcards = True
.Format = True
.Font.Italic = True
While .Execute
With oRng
.InsertBefore "<em>"
.InsertAfter "</em>"
.Font.Italic = False
.Collapse wdCollapseEnd
End With
Wend
End With
End Sub