For intLoopRow =  0  To intRows -  1 
        'Создаем новый документ на основе шаблона
        Set Doc = Nothing
        If arrayRows( 2 , intLoopRow) = "Null" Or LCase(arrayRows( 2 , intLoopRow)) = "нет" Then
            Set Doc = ObjWord.Documents.Add(PathDOT & "\" & "СлужебнаяЗапискаДО.doc")
        Else
            Set Doc = ObjWord.Documents.Add(PathDOT & "\" & "Распоряжение.doc")
        End If
        ObjWord.Visible = True
        'Запрашиваем данные из базы
        rstOrgProduct.Open "select * from ows.Opt_EskRaspOrgProduct " _
        & "where feeYear = '" + CStr(arrayRows( 3 , intLoopRow)) + "' " _
        & "and orgNAME = '" + CStr(arrayRows( 1 , intLoopRow)) + "' " _
        & "and productNAME = '" + CStr(arrayRows( 12 , intLoopRow)) + "'", cnn
        'Находим число записей в наборе
        If Not rstOrgProduct.EOF Then
            rstOrgProduct.MoveFirst
            intRowsRst =  0 
            Do While Not rstOrgProduct.EOF
                intRowsRst = intRowsRst +  1 
                rstOrgProduct.MoveNext
            Loop
            rstOrgProduct.MoveFirst
            arrayRowsRst = rstOrgProduct.GetRows(intRowsRst)
        Else
            intRowsRst =  0 
        End If
        'Вводим данные из массива в шаблон
        With Doc.Bookmarks
            .Item("OfficeCode").Range.Text = CStr(arrayRows( 13 , intLoopRow))
            .Item("RaspNumber").Range.Text = CStr(intRaspNumber)
            .Item("CurrDate").Range.Text = CStr(Date) + "г."
            .Item("Name").Range.Text = arrayRows( 1 , intLoopRow)
            Select Case CStr(arrayRowsRst( 5 ,  0 ))
            Case  810 
                strFeeType = "рублей 00 коп."
            Case  840 
                strFeeType = "долларов 00 центов"
            Case  978 
                strFeeType = "евро 00 евроцентов"
            End Select
            .Item("FeeYear").Range.Text = CStr(intRowsRst * CInt(arrayRows( 3 , intLoopRow))) + " " + strFeeType
            .Item("FeeYears").Range.Text = TextSum(intRowsRst * CInt(arrayRows( 3 , intLoopRow)), arrayRowsRst( 5 ,  0 ))
            .Item("CardCount").Range.Text = intRowsRst
            .Item("Month1Day").Range.Text = CStr(Month1Day) + "г."
            If arrayRows( 4 , intLoopRow) <> "Null" Then
                .Item("NoteDoc").Range.Text = arrayRows( 4 , intLoopRow)
            Else
                .Item("NoteDoc").Range.Text = "RDF" '?What needs?
            End If
            If arrayRows( 2 , intLoopRow) = "Null" Or LCase(arrayRows( 2 , intLoopRow)) = "нет" Then
                If arrayRows( 4 , intLoopRow) <> "Null" Then
                    .Item("NoteDoc2").Range.Text = arrayRows( 4 , intLoopRow)
                Else
                    .Item("NoteDoc2").Range.Text = "RDF" '?What needs?
                End If
            Else
                .Item("BankAcc").Range.Text = "№ " & arrayRows( 2 , intLoopRow)
            End If
            .Item("FIO").Range.Text = strUserFIO
        End With
        'Переходим в конец документа
        Doc.ActiveWindow.Selection.EndKey Unit:=wdStory
        Doc.ActiveWindow.Selection.InsertBreak Type:=wdPageBreak
        'Записываем название организации
        Doc.ActiveWindow.Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
        Doc.ActiveWindow.Selection.TypeText Text:="Руководителю предприятия"
        Doc.ActiveWindow.Selection.TypeParagraph
        Doc.ActiveWindow.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
        Doc.ActiveWindow.Selection.TypeText Text:= _
        "Списки сотрудников для безакцептного списания за обслуживание карт по зарплатной " _
        & "программе (Код - " + arrayRows( 12 , intOrg) + ") " + arrayRows( 6 , intOrg)
        Doc.ActiveWindow.Selection.EndKey Unit:=wdStory
        Doc.ActiveWindow.Selection.Font.Size =  10 
        'Создаем пустую таблицу
        Set tblList = Doc.Tables.Add(Doc.ActiveWindow.Selection.Range, NumRows:=intRowsRst +  2 , NumColumns:= 4 )
        With tblList
            If .Style <> "Сетка таблицы" Then
                .Style = "Сетка таблицы"
            End If
            .ApplyStyleHeadingRows = True
            .ApplyStyleLastRow = False
            .ApplyStyleFirstColumn = True
            .ApplyStyleLastColumn = False
            '.ApplyStyleRowBands = True
            '.ApplyStyleColumnBands = False
        End With
        tblList.Select
        'Заполнение таблицы
        intItog =  0 
        tblList.Columns( 1 ).Width =  45 
        tblList.Columns( 2 ).Width =  250 
        tblList.Columns( 3 ).Width =  100 
        tblList.Columns( 4 ).Width =  75 
        tblList.Cell( 1 ,  1 ).Range.InsertAfter "№ п/п"
        tblList.Cell( 1 ,  2 ).Range.InsertAfter "ФИО"
        tblList.Cell( 1 ,  3 ).Range.InsertAfter "Номер карты"
        tblList.Cell( 1 ,  4 ).Range.InsertAfter "Комиссия"
        If intRowsRst <>  0  Then
                    For intRstOrgProduct =  0  To intRowsRst -  1 
                        strClientName = CStr(arrayRowsRst( 0 , intRstOrgProduct)) + " " + CStr(arrayRowsRst( 1 , intRstOrgProduct))
                        If arrayRowsRst( 2 , intRstOrgProduct) <> "Null" Then
                            strClientName = strClientName + " " + CStr(arrayRowsRst( 2 , intRstOrgProduct))
                        End If
                        Select Case arrayRowsRst( 5 , intRstOrgProduct)
                        Case  810 
                            strFeeType = "RUR"
                        Case  840 
                            strFeeType = "USD"
                        Case  978 
                            strFeeType = "EUR"
                        End Select
                        strFee = CStr(arrayRowsRst( 4 , intRstOrgProduct)) + ".00 " + strFeeType
                        tblList.Cell(intRstOrgProduct +  2 ,  1 ).Range.InsertAfter intRstOrgProduct +  1 
                        tblList.Cell(intRstOrgProduct +  2 ,  2 ).Range.InsertAfter strClientName
                        tblList.Cell(intRstOrgProduct +  2 ,  3 ).Range.InsertAfter arrayRowsRst( 3 , intRstOrgProduct)
                        tblList.Cell(intRstOrgProduct +  2 ,  4 ).Range.InsertAfter strFee
                        intItog = intItog + CInt(arrayRowsRst( 4 , intRstOrgProduct))
                    Next
                    strItog = CStr(intItog) + ".00 " + strFeeType
                    tblList.Cell(intRstOrgProduct +  2 ,  2 ).Range.InsertAfter "Итого"
                    tblList.Cell(intRstOrgProduct +  2 ,  4 ).Range.InsertAfter strItog
        End If
        intOrg = intOrg +  1 
        'Инкремент номера распоряжения
        intRaspNumber = intRaspNumber +  1 
        'Закрываем набор данных
        rstOrgProduct.Close
        'Переходим в начало документа
        Doc.ActiveWindow.Selection.HomeKey Unit:=wdStory
        'задаем путь к конечному создаваемому каталогу
        strPathDir = "F:\CARD_FEE_YEARLY\" + CStr(Year(Date)) + "-" + CStr(Month(Date)) + "\"
        'проверяем, есть ли такой путь и если нету, вызываем процедуру
        'для создания соответствующих каталогов
        If Dir(strPathDir, vbDirectory) = "" Then
            Call MakeTreeDirectory(strPathDir)
        End If
        'Сохраняем документ
        strFileName = strPathDir + CStr(arrayRows( 6 , intLoopRow)) + " fee " + _
        CStr(arrayRows( 3 , intLoopRow)) + " prod " + CStr(arrayRows( 12 , intLoopRow)) + ".doc"
        Doc.SaveAs (strFileName)
        'Печать документа
        Doc.PrintOut
        Doc.Close wdSaveChanges
    Next