Word Macro For Saving Files With Variable Default Name According to Text Value in Heading 1

[zanodor]

I am new to macros so I was hunting around for procedures on the internet trying to find solutions as to how to carry out various automations for large Word documents. Thank goodness, I am now 2/3 of the way done.

The remaining task is the following:
In a folder containing all my files, split all Word documents by Section Breaks and name the new files according to the text value in the first line of Heading 1 up to the unit-ending dot.


In my case, this unit can be one character, two, three, even 4-5 words (when I was at a loss how to name somthing), complete with diacritics (my texts are bilingual). Example:


The key is to cover everything up to the dot. All titles of these entries have a dot at the end.
If the solution can only work with dashes ("-") or underscore characters ("_") between words, I can live with that. Especially because these documents will have to be converted to MD files and I don't know how PanDoc will handle my files.
But spaces between words and the unicode use of all accented words would be best. I could probable use a universal batch rename software to alter my filenames later, should the need arise.
Some titles that deal with so-called etymons are all capitals, so I'd need those intact as well, if possible.

I have various codes of VBA that I was using, so here is an example. If someone could append this with the modification, that would be perfect:

Sub SaveEachSectionAsADoc()
  Dim objDocAdded As Document
  Dim objDoc As Document
  Dim nSectionNum As Integer
  Dim strFolder As String

  Dim dlgFile As FileDialog
 
  ' Initialization
  Set objDoc = ActiveDocument
 
  Set dlgFile = Application.FileDialog(msoFileDialogFolderPicker)
 
  ' Pick a location to keep new files.
  With dlgFile
    If .Show = -1 Then
      strFolder = .SelectedItems(1) & "\"
    Else
      MsgBox "Select a folder first!"
      Exit Sub
    End If
  End With
 
  ' Step through each section in current document, copy and paste each to a new one.
  For nSectionNum = 1 To ActiveDocument.Sections.Count
    Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Name:=nSectionNum
    ActiveDocument.Sections(nSectionNum).Range.Copy
 
    Set objDocAdded = Documents.Add
    Selection.Paste
 
    ' Save and close new documents.
    objDocAdded.SaveAs FileName:=strFolder & "Section " & nSectionNum & ".docx"
    objDocAdded.Close
  Next nSectionNum
End Sub

I would need a code that batch handles all files in a folder, with two sets of loops: one to handle all sections within a file (as in the code above) and one to go through all files in a folder.

If there is absolutely no way to implement this, maybe there is another way: the headings to be used as filenames are always bold and underlined. That is the unit/value to be used. Whatever comes after the delimiter dot (usually in the same line) is not to be taken to account.
If there is no parameter/expression to achieve that, a code which saves files based on the first 3 words in Heading 1 would suffice (in that case, the dot would also be present in many instances, of course).

Any help is greatly appreciated.
Thanks in advance,

Zan