Option Explicit

Public list_of_lists_of_ingredients_ranges  As Collection
Public ingredients_directory                As String

Sub covert_lists_of_ingredients_to_includetext_fields()

Dim index                               As Integer
Dim list_of_ingredients                 As Word.Range
Dim ingredients_path                    As String
Dim ingredients_range                   As Word.Range

    'create a directory for the ingredient files
    ingredients_directory = ActiveDocument.Path & "\" & Replace(ActiveDocument.Name, ".docx", vbNullString) & "_ingredients"
    If Len(Dir(ingredients_directory, vbDirectory)) = 0 Then
        MkDir ingredients_directory
    End If
    compile_list_of_lists_of_ingredients_ranges
    
    'create a document for each set of ingredients and insert insterttextfield
    For index = 1 To list_of_lists_of_ingredients_ranges.Count
    
        ingredients_path = create_ingredients_document(index)
        
        Set ingredients_range = list_of_lists_of_ingredients_ranges(index)
        With ingredients_range
            .Delete
            .Fields.Add _
                Range:=ingredients_range, _
                Type:=wdFieldIncludeText, _
                Text:=Chr$(34) & Replace(ingredients_path, "\", "\\") & Chr$(34), _
                preserveformatting:=False
        End With
    Next
    
End Sub

Sub compile_list_of_lists_of_ingredients_ranges()

Dim search_range                        As Word.Range
Dim ingredient_heading_ranges           As Collection
Dim heading_range                       As Variant
    
    Set ingredient_heading_ranges = New Collection
    Set search_range = ActiveDocument.StoryRanges(wdMainTextStory)
    
    With search_range.Find
        Do
            .ClearFormatting
            .Format = True
            .Wrap = wdFindStop
            .Style = "Heading 4"
            .Text = "Ingredients"
            .Execute
            If .Found Then
                ingredient_heading_ranges.Add search_range.Duplicate
            End If
        Loop While .Found
    End With
    
    Set list_of_lists_of_ingredients_ranges = New Collection
    
    ' now get the ranges for the lists of ingedients
    For Each heading_range In ingredient_heading_ranges
        list_of_lists_of_ingredients_ranges.Add get_ingredients_range_from_heading_range(heading_range)
    Next
        
End Sub

Function get_ingredients_range_from_heading_range(this_range As Variant) As Word.Range

    this_range.Move unit:=wdParagraph
    Do Until this_range.Next(unit:=wdParagraph).Style = "Normal"
        this_range.MoveEnd unit:=wdParagraph
    Loop
    Set get_ingredients_range_from_heading_range = this_range
    
End Function

Function create_ingredients_document(this_item As Integer) As String ' name of document
Dim this_doc                            As Word.Document
    
    Set this_doc = Application.Documents.Add(Template:=ActiveDocument.AttachedTemplate.FullName, Visible:=False)
    this_doc.StoryRanges(wdMainTextStory).FormattedText = list_of_lists_of_ingredients_ranges(this_item).FormattedText
    this_doc.StoryRanges(wdMainTextStory).Characters.Last.Delete
    this_doc.SaveAs2 _
        ingredients_directory _
        & "\" _
        & Replace(ActiveDocument.Name, ".docx", "_ingredients_" & Format(this_item, "00") & ".docx")
      
        
    create_ingredients_document = this_doc.FullName
    this_doc.Close savechanges:=False
End Function