' rem для VB или VBA
Function InsertText_m&(ByVal sPath$, ByVal sText$, Optional lngStartCount& =  1 &)
' параметры
'   sPath - путь к папке с файло'м
'   sText - текст для вставки
'   lngStartCount - с какого числа начнется "крутиться" счетчик
' возвращаемое значение
'   количество обработаных файлов
Dim s$, k&
Dim w As Object
    
rem никто не запрещает сделать проверку корректности переданых параметроф
rem никто не запрещает дописать обработчик ошибок и логирование
rem никто ничего не запрещает...

    If Right(sPath,  1 ) <> "\" Then sPath = sPath & "\"
    s = Dir(sPath & "*.doc")

    If s > "" Then
    Set w = CreateObject("Word.Application")    

    If Right(sText,  1 ) <> " " Then sText = sText & " "
    k = lngStartCount    
    
    Do
        With w.Documents.Open(sPath & s)
            With .Paragraphs
                .Add .Item( 1 ).Range
                With .Item( 1 )
                    .Style = - 3  'wdStyleHeading2==-3
                    .Range.InsertBefore sText & CStr(k)
                End With
            End With
            .Save: .Close
        End With
        k = k +  1 : s = Dir
    Loop While s > ""
    
    w.Quit: Set w = Nothing
    
    InsertText_m = k - lngStartCount
    End If
End Function