Sub Test_PassToFunction()

    Dim rngTitle As Range
    
    Set rngTitle = ActiveDocument.Words(1)
        
    rngTitle.Text = "SECTION 00 00 00 - THIS IS THE TITLE OF THE SECTION"
    ' (The string is actually a variable coming from another macro.)
    
    fcnTitleCase (rngTitle)
    
End Sub

Function fcnTitleCase(rngTitle)
' From Allen Wyatt
' https://word.tips.net/T000215_Intelligent_Title_Case.html

    Dim lclist As String
    Dim wrd As Integer
    Dim sTest As String

    ' list of lowercase words, surrounded by spaces
    lclist = " of the by to this is from a "

    Selection.Range.Case = wdTitleWord

    For wrd = 2 To Selection.Range.Words.Count
        sTest = Trim(Selection.Range.Words(wrd))
        sTest = " " & LCase(sTest) & " "
        If InStr(lclist, sTest) Then
            Selection.Range.Words(wrd).Case = wdLowerCase
        End If
    Next wrd
 End Function

Sub Test_PassToFunction()
  Dim rngTitle As Range
  
  Set rngTitle = ActiveDocument.Words(1)
  rngTitle.Text = "SECTION 00 00 00 - THIS IS THE TITLE OF THE SECTION"    ' (The string actually a variable coming from another macro.)
  MakeTitleCase rngTitle
End Sub

Sub MakeTitleCase (rng As Range)
  ' Modified from Allen Wyatt  https://word.tips.net/T000215_Intelligent_Title_Case.html
  Dim lclist As String, iWord As Integer, sTest As String

  lclist = " of the by to this is from a "    ' List of lowercase words, surrounded by spaces
  rng.Case = wdTitleWord                      ' Make Camel Case

  For iWord = 2 To rng.Words.Count
    sTest = " " & LCase(Trim(rng.Words(iWord))) & " "
    If InStr(lclist, sTest) Then
      rng.Words(iWord).Case = wdLowerCase
    End If
  Next iWord
End Sub

Set rngTitle = ActiveDocument.Words(1)

Set rngTitle.Text = "SECTION 00 00 00, ETC."

Option Explicit

Sub FormatTitle()
Const sList As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 -"
Dim rngTitle As Range
    Set rngTitle = ActiveDocument.Range
    rngTitle.Collapse 1
    rngTitle.MoveEndWhile sList
    TrueTitleCase rngTitle
End Sub

Sub TrueTitleCase(oRng As Range)
Dim vFindText As Variant
Dim vReplText As Variant
Dim i As Long
Dim k As Long
Dim m As Long
    'count the characters in the selected string
    k = Len(oRng)
    If k < 1 Then
        'If none, then the range is empty
        'so warn the user
        MsgBox "The range has no text!", vbOKOnly, "No text selected"
        Exit Sub    'and quit the macro
    End If
    'format the selected string as title case
    oRng.Case = wdTitleWord
    'list the exceptions to look for in an array
    vFindText = Array("A", "An", "And", "As", "At", "But", "By", "For", _
                      "If", "In", "Of", "On", "Or", "The", "To", "With")
    'list their replacements in a matching array
    vReplText = Array("a", "an", "and", "as", "at", "but", "by", "for", _
                      "if", "in", "of", "on", "or", "the", "to", "with")
    With oRng
        With .Find
            'replace items in the first list
            'with the corresponding items from the second
            .ClearFormatting
            .Replacement.ClearFormatting
            .Forward = True
            .Wrap = wdFindStop
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Format = True
            .MatchCase = True
            For i = LBound(vFindText) To UBound(vFindText)
                .Text = vFindText(i)
                .Replacement.Text = vReplText(i)
                .Execute Replace:=wdReplaceAll
            Next i
        End With
        'Reduce the range of the selected text
        'to encompass only the first character
        .MoveEnd Unit:=wdCharacter, Count:=-Len(oRng) + 1
        'format that character as upper case
        .Case = wdUpperCase
        'restore the selected text to its original length
        .MoveEnd Unit:=wdCharacter, Count:=k
        'and check to see if the string contains a colon
        If InStr(1, oRng, ":") > 0 Then
            'If it does note the position of the character
            'after the first colon
            m = InStr(1, oRng, ":") + 1
            'and set that as the new start of the selected text
            .MoveStart wdCharacter, m
            'set the end of the selected text to include
            'one extra character
            .MoveEnd Unit:=wdCharacter, Count:=-Len(oRng) + 1
            'format that character as upper case
            .Case = wdUpperCase
        End If
    End With
lbl_Exit:
    Exit Sub
End Sub

Sub FormatTitle()
    TrueTitleCase ActiveDocument.Paragraphs(1).Range
End Sub

Sub LoopAllWordFilesInFolder()

    Dim docDocument As Document
    Dim strPath As String
    Dim strFile As String
    Dim strExtension As String
    Dim FolderPicker As FileDialog

    Application.ScreenUpdating = False

    ' Get target folder path from user:
    Set FolderPicker = Application.FileDialog(msoFileDialogFolderPicker)
        With FolderPicker
            .Title = "Choose the folder containing your files"
            .AllowMultiSelect = False
                If .Show <> -1 Then GoTo NextCode
                strPath = .SelectedItems(1) & "\"
        End With

' In case the user cancels:
NextCode:
    strPath = strPath
    If strPath = "" Then GoTo ResetSettings
  
    ' To run the macro on .DOCX files only, change "*.doc*" to "*.docx"
    ' To run the macro on .DOC files only, change "*.doc*" to "*.doc"
    strExtension = "*.doc*"

    ' Target path with file extension:
    strFile = Dir(strPath & strExtension)
    
    ' Loop through each file in the folder:
    Do While strFile <> ""
        ' Set variable equal to opened document:
        Set docDocument = Documents.Open(FileName:=strPath & strFile)

        ' Use DoEvents to ensure document has opened before moving on to next line of code.
        DoEvents

' CALL OTHER MACROS HERE:
                                  
            Call Specs_GetNameAndNumber

        ' Save and close document:
        If docDocument.Saved = False Then docDocument.Save
        docDocument.Close
        ' Ensure document has closed before moving on to next line of code:
        DoEvents
        ' Get next file name:
        strFile = Dir
    Loop

    MsgBox "The macro has looped through the files in the folder you chose and completed the tasks."

' Reset macro optimization settings:
ResetSettings:
    Application.ScreenUpdating = True
End Sub

Sub Specs_GetNameAndNumber() ' 08/19/2021

' This macro speeds up PDFing spec packages by setting the Author and Title
' properties in Word so that they don't have to be manually set in Acrobat,
' and it creates a rough ToC (using the spec template), if needed.

' The macro does the following:
' 1. Gets spec section number, presumed to be the first or second line of a
'    document; however, the macro will loop through the initial paragraphs and
'    skip blank ones (doesn't matter if name/numbers are in content controls)
' 2. Gets spec section name, presumed to be after section number; again,
'    the macro skips blank lines
' 3. Removes hard and soft returns and tabs that end up in the the name/number
'    variables and trims spaces from the beginning/end of each
' 4. Concatenates the two lines into a single string, i.e., the title
' 5. Changes the string to camel case, if necessary, per in-house style and
'    bookmarking reqs.
' 6. Populates file document properties:
'     - Title
'     - Author (set to "Company Name")
' 7. If needed, creates a rough ToC based on spec template and applies formatting

    Dim strSectionNumber As String
    Dim strSectionName As String
    Dim strTitle As String
    
    Dim i As Long ' Counter to loop through  first paragraphs in the section
    Dim k As Long ' To remove hard and soft returns and tabs from strings
    
    ' Loop through the first paragraphs until the section name -- the second
    ' variable -- is assigned:
    i = 1
    
    Do Until strSectionName <> ""
        ' If the paragraph is empty (i.e., has a char. length of 1 [which is for
        ' the pilchrow]), then skip the paragraph:
        If ActiveDocument.Paragraphs(i).Range.Characters.Count = 1 Then
            i = i + 1
        ' Otherwise, if section number or name variable hasn't been assigned, do it:
        Else
            If strSectionNumber = "" Then
                strSectionNumber = ActiveDocument.Paragraphs(i).Range.Text
                ' Increment counter to next paragraph:
                i = i + 1
            ' If the section number variable has been assigned, then assign the
            ' section name variable:
            ElseIf strSectionName = "" Then
                strSectionName = ActiveDocument.Paragraphs(i).Range.Text
                ' Debug.Print strSectionName
            End If
        End If
    Loop
    
    ' Clean up and concatenate the strings to create the title:
    ' a. Remove tabs, paragraph marks, and soft returns, which are
    '    Chr(9), Chr(11), and Chr(13), respectively:
        For k = 9 To 13 Step 2
            strSectionNumber = Replace(strSectionNumber, Chr(k), "")
            strSectionName = Replace(strSectionName, Chr(k), "")
        Next k

    ' b. Trim spaces from both ends of the strings:
        strSectionNumber = Trim(strSectionNumber)
        strSectionName = Trim(strSectionName)
        
    ' c. Concatenate the number and name and assign to a variable:
        strTitle = strSectionNumber & " - " & strSectionName
        Debug.Print strTitle
                
    ' Change to camel case:
    
        ' ?????????????????
                
    ' Populate the file's document properties:
    Call DocProperties_SetInFile(strTitle)

    ' Create rough ToC (pending):
    ''Call ExtractListOfSectionsToNewDoc
 End Sub