Create Word File With Hierarchy Using Excel VBA

Sub CreateWordFileWithHierarchy()
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim WordRange As Object
    
    ' Create Word application and document objects
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Set WordApp = CreateObject("Word.Application")
        Err.Clear
    End If
    On Error GoTo 0
    
    WordApp.Visible = True
    Set WordDoc = WordApp.Documents.Add

    ' Sample data structure in Excel for headings and content
    ' Column A: Level (1 for Main Heading, 2 for Subheading, 3 for Bullet Points, etc.)
    ' Column B: Content
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long

    Set ws = ThisWorkbook.Sheets(1)
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    For i = 2 To lastRow
        Dim level As Integer
        Dim content As String
        
        level = ws.Cells(i, 1).Value
        content = ws.Cells(i, 2).Value


        If level = 1 Then
            ' Main Heading  (Heading 1)
            Set WordRange = WordDoc.content
            WordRange.Collapse Direction:=0
            WordRange.Text = content
            WordRange.Style = WordDoc.Styles("Title")
            WordRange.InsertParagraphAfter
        ElseIf level = 2 Then
            ' Main Heading  (Heading 1)
            Set WordRange = WordDoc.content
            WordRange.Collapse Direction:=0
            WordRange.Text = content
            WordRange.Style = WordDoc.Styles("Heading 1")
            WordRange.InsertParagraphAfter
        ElseIf level = 3 Then
            ' Subheading (Heading 2)
            Set WordRange = WordDoc.content
            WordRange.Collapse Direction:=0
            WordRange.Text = content
            WordRange.Style = WordDoc.Styles("Heading 2")
            WordRange.InsertParagraphAfter
'        ElseIf level = 4 Then
'            'Heading 3
'            Set WordRange = WordDoc.content
'            WordRange.Collapse Direction:=0
'            WordRange.Text = content
'            WordRange.Style = WordDoc.Styles("Heading 3")
'            WordRange.ListFormat.ApplyBulletDefault
'            WordRange.InsertParagraphAfter
'         ElseIf level = 5 Then
'            ' Bullet Points
'            Set WordRange = WordDoc.content
'            WordRange.Collapse Direction:=0
'            WordRange.Text = content
'            WordRange.Style = WordDoc.Styles("Normal")
'            WordRange.ListFormat.ApplyBulletDefault
'            WordRange.InsertParagraphAfter
'
'
'         ElseIf level = 6 Then
'            ' Bullet Points
'            Set WordRange = WordDoc.content
'            WordRange.Collapse Direction:=0
'            WordRange.Text = content
'            WordRange.Style = WordDoc.Styles("List Paragraph")
'            WordRange.ListFormat.ApplyBulletDefault
'            WordRange.InsertParagraphAfter
'
        End If
    Next i

    ' Save and close the document
    Dim savePath As String
'    savePath = Application.DefaultFilePath & "\HierarchyDocument.docx"
'    WordDoc.SaveAs2 savePath
    MsgBox "Document created and saved at: " & savePath, vbInformation

    ' Cleanup
    Set WordRange = Nothing
    Set WordDoc = Nothing
    Set WordApp = Nothing
End Sub