Check Word Document Style for every single lines - vba

Question

I have a Word Document with mixed styles and need to add HTML tags if the line matches h1, h2 or h3.
I'm trying to save the new string into an array and save as .html file
But have no idea how to write the if condition in .vba, so please help.
Public Sub Word2HTML()
Dim NewArray() As String
Dim TextFile As Integer
Dim FilePath As String
FilePath = "C:\Temp\final.html"
TextFile = FreeFile
'Open the text file
Open FilePath For Output As TextFile
For i = 1 To ActiveDocument.Paragraphs.Count
' error on the next line
If ActiveDocument.Paragraphs(i).Style.Text = "Heading 1" Then
ReDim Preserve NewArray(i-1)
NewArray(i-1) = "<h1>" + ActiveDocument.Paragraphs(i) + "</h1>"
Elseif ActiveDocument.Paragraphs(i).Style.Text = "Heading 2" Then
ReDim Preserve NewArray(i-1)
NewArray(i-1) = "<h2>" + ActiveDocument.Paragraphs(i) + "</h2>"
Elseif ActiveDocument.Paragraphs(i).Style.Text = "Heading 3" Then
ReDim Preserve NewArray(i-1)
NewArray(i-1) = "<h3>" + ActiveDocument.Paragraphs(i) + "</h3>"
Else
End If
Next i
For Each headline In NewArray
Print #TextFile, headline
Next
Close TextFile
End Sub
Here is the error message I got from MS Word VB

Answer 1

The following captures all headings and saves them to an HTML file with the same name as the active document:
Sub HeadingsToHTML()
Application.ScreenUpdating = False
Dim Rng As Range, h As Long
With ActiveDocument
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Font.Bold = True
.Wrap = wdFindContinue
.Text = ""
.Replacement.Text = "<strong>^&</strong>"
.Execute Replace:=wdReplaceAll
.Text = "^p"
.Replacement.Text = "</strong>^&<strong>"
.Execute Replace:=wdReplaceAll
End With
Set Rng = .Range(0, 0)
Set Rng = .TablesOfContents.Add(Range:=Rng, UseHeadingStyles:=True, _
UpperHeadingLevel:=1, LowerHeadingLevel:=9, IncludePageNumbers:=False).Range
Rng.Fields.Unlink
Rng.Collapse wdCollapseEnd
Rng.End = .Range.End
Rng.Delete
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
For h = 1 To 9
.Style = "TOC " & h
.Text = "([!^13]{1,})"
.Replacement.Text = "<h" & h & ">\1</h" & h & ">"
.Execute Replace:=wdReplaceAll
Next
End With
.SaveAs2 FileName:=Split(.FullName, ".doc")(0) & ".html", FileFormat:=wdFormatText, AddToRecentFiles:=False
End With
Application.ScreenUpdating = True
End Sub
Way faster than looping through all paragraphs, too.
If your headings have level #s and you don't want those in the output, replace:
.Text = "([!^13]{1,})"
with:
.Text = "[!^13]#^t([!^13]{1,})"

Answer 2

Styles do not have a .Text property. You probably are trying to do this:
If ActiveDocument.Paragraphs(i).Style = "Heading 1" Then
' do something here
End If