Не работает цикл для вывода записей из Access в Excel - VBA

Формулировка задачи:

Здравствуйте! Создаю отчет в Excel на основе данных из Access. Имеется форма, надо на её основе построить отчет в Excel. Проблема с выводом подчиненной формы (снизу формы). Сделал такой цикл, но он выводит только первую строку таблицы зданий (строка 301):

Public Sub AccountExcel()
 
Dim RSset As ADODB.Recordset  ' Набор данных
Set RSset = New ADODB.Recordset
' Рабочие переменные. Их тип - Variant
Dim I, RightAddress
Dim SQLText, SQLText1 As String
Dim oExcel As Object
' Создание объекта
Set oExcel = CreateObject("Excel.Application")
' Локальные переменные
Dim ClientAddress, ObjectAddress, nRow, ClientFIO
 
' Сделать окно Microsoft Excel видимым
    oExcel.Application.Visible = True
    oExcel.Application.CommandBars("Standard").Visible = False
    oExcel.Application.CommandBars("Formatting").Visible = False
' Размеры окна и его место на экране дисплея
    oExcel.Application.WindowState = xlMaximized
' Добавляем рабочую книгу
    oExcel.WorkBooks.Add
' При закрытии рабочей книги без сохранения
' ошибка формироваться не будет
    oExcel.DisplayAlerts = False
' Масштаб изображения 75%
    oExcel.ActiveWindow.Zoom = 75
' Заголовок окна Excel
    oExcel.Caption = "Договор"
' Ориентация альбомная поля по 1.5 см Бумага A4
    oExcel.ActiveSheet.PageSetup.LeftMargin = 42
    oExcel.ActiveSheet.PageSetup.RightMargin = 42
    oExcel.ActiveSheet.PageSetup.TopMargin = 42
    oExcel.ActiveSheet.PageSetup.BottomMargin = 42
    oExcel.ActiveSheet.PageSetup.Orientation = xlLandscape
    oExcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4
' Для всей Excel-таблицы
    oExcel.Cells.Font.Name = "Arial"
    oExcel.Cells.Font.Size = 8
 
' Устанавливаем ширину колонок
    oExcel.Columns("A:A").ColumnWidth = 16
    oExcel.Columns("B:B").ColumnWidth = 11
    oExcel.Columns("C:C").ColumnWidth = 7
    oExcel.Columns("D:D").ColumnWidth = 7
    oExcel.Columns("E:E").ColumnWidth = 14
    oExcel.Columns("F:F").ColumnWidth = 11
 
    oExcel.Range("B1:D1").Select
    With oExcel.Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.Selection.Merge
    oExcel.Range("B1:D1").Select
    oExcel.ActiveCell.FormulaR1C1 = "Договор охраны объекта №"
    oExcel.Range("E1").Select
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.ActiveCell.FormulaR1C1 = SelectTreatyID
 
    oExcel.Range("A3").Select
    oExcel.ActiveCell.FormulaR1C1 = "ФИО клиента:"
 
ClientFIO = SelectClientSurname & " " & _
        SelectClientName & " " & _
        SelectClientPatronymic
        
    oExcel.Range("B3:E3").Select
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.Selection.Merge
    oExcel.ActiveCell.FormulaR1C1 = ClientFIO
    
    oExcel.Range("A4").Select
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.ActiveCell.FormulaR1C1 = "Телефон:"
    
    oExcel.Range("B4:E4").Select
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.Selection.Merge
    oExcel.ActiveCell.FormulaR1C1 = SelectClientPhone

    With RSset
     ' Задание свойств объекта RSset (Recordset)
     ' Источник: SQL-конструкция
     
     SQLText = "SELECT * FROM tblAddress " & _
                " WHERE Address = " & SelectClientAddress
 
     .Source = SQLText
     
     ' Указатель на открытое соединение
     .ActiveConnection = CurrentProject.Connection
     .CursorType = adOpenKeyset   ' Тип курсора
     .Open
    End With
     
     If RSset(3) = False Then
   ' Признак адреса стоит первым
   RightAddress = Trim(RSset(2)) & " " & _
                Trim(RSset(1))
    Else
    ' Признак адреса стоит вторым
   RightAddress = Trim(RSset(1)) & " " & _
                Trim(RSset(2))
    End If
RSset.Close ' Закрытие набора данных
    
    oExcel.Range("A5").Select
    oExcel.ActiveCell.FormulaR1C1 = "Адрес клиента:"
    
    ClientAddress = "г. Хабаровск, " & _
    RightAddress & ", дом " & _
    str(SelectClientHouse) & ", кв. " & _
    str(SelectClientFlat) & "."
    
    oExcel.Range("A3:A5").Select
    oExcel.Selection.Font.Bold = True
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    oExcel.Range("B5:E5").Select
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.Selection.Merge
    oExcel.ActiveCell.FormulaR1C1 = ClientAddress
 
    oExcel.Range("A7").Select
    oExcel.Selection.Font.Bold = True
    oExcel.ActiveCell.FormulaR1C1 = "Дата начала договора:"
    oExcel.Range("B7").Select
    oExcel.ActiveCell.FormulaR1C1 = SelectDateStart
    
    oExcel.Range("C7:E7").Select
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    oExcel.ActiveCell.FormulaR1C1 = "Дата окончания договора:"
    oExcel.Range("C7:E7").Select
    oExcel.Selection.Font.Bold = True
    
    oExcel.Range("F7").Select
    oExcel.ActiveCell.FormulaR1C1 = SelectStopDate
    
    oExcel.Range("B9:F9").Select
    With oExcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.Selection.Merge
    oExcel.ActiveCell.FormulaR1C1 = "Объекты охраны, прописанные в договоре:"
    
    oExcel.Range("A10").Select
    With oExcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.ActiveCell.FormulaR1C1 = "Объект №"
    oExcel.Range("B10:E10").Select
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.Selection.Merge
    oExcel.ActiveCell.FormulaR1C1 = "Адрес:"
    oExcel.Range("F10").Select
    oExcel.ActiveCell.FormulaR1C1 = "Дом"
    oExcel.Range("G10").Select
    oExcel.ActiveCell.FormulaR1C1 = "Кв."
    oExcel.Range("A10:G10").Select
    oExcel.Selection.Font.Bold = True

With RSset
     ' Задание свойств объекта RSset (Recordset)
     ' Источник: SQL-конструкция
     
    SQLText = "SELECT tblTreatyDetail.TreatyID, tblTreatyDetail.ObjectID, " & _
    " tblAddress.AddressName, tblAddress.AddressSign, tblAddress.AddressFirst, " & _
    " tblObject.House, tblObject.Flat " & _
    " FROM tblTreaty INNER JOIN ((tblAddress INNER JOIN tblObject " & _
    " ON tblAddress.Address = tblObject.Address) INNER JOIN tblTreatyDetail " & _
    " ON tblObject.ObjectID = tblTreatyDetail.ObjectID)" & _
    " ON tblTreaty.TreatyID = tblTreatyDetail.TreatyID " & _
    " WHERE tblTreatyDetail.TreatyID = " & SelectTreatyID & _
    " AND tblTreatyDetail.ObjectID = " & SelectObjectID
    
    .Source = SQLText
     
     ' Указатель на открытое соединение
     .ActiveConnection = CurrentProject.Connection
     .CursorType = adOpenKeyset   ' Тип курсора
     .Open
    End With
     
     If RSset(4) = False Then
   ' Признак адреса стоит первым
   RightAddress = Trim(RSset(3)) & " " & _
                Trim(RSset(2))
    Else
    ' Признак адреса стоит вторым
   RightAddress = Trim(RSset(2)) & " " & _
                Trim(RSset(3))
    End If
 
For I = 0 To RSset.RecordCount - 1
    RSset.Move I, adBookmarkFirst
    oExcel.Range("B" & I + 11 & ":E" & I + 11).Select
    With oExcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    oExcel.Selection.Merge
    With oExcel
    .Range("A" & I + 11).Select
    .ActiveCell.FormulaR1C1 = RSset.Fields(1).Value
    .Range("B" & I + 11 & ":E" & I + 11).Select
    .ActiveCell.FormulaR1C1 = RightAddress
    .Range("F" & I + 11).Select
    .ActiveCell.FormulaR1C1 = RSset.Fields(5).Value
    .Range("G" & I + 11).Select
    .ActiveCell.FormulaR1C1 = RSset.Fields(6).Value
    End With
Next I

' Переход в начало отчета
oExcel.Range("A1").Select
' Устанавливаем защиту рабочего листа и книги
' Пароль - текущее время
oExcel.ActiveSheet.Protect ("' + Time() + '")
oExcel.ActiveWorkbook.Protect ("' + Time() + '")
RSset.Close
Set RSset = Nothing
End Sub

В чем может быть ошибка? И, есть советы как сделать форматирование этой таблицы (границы)? БД Access 2010:47 Маслов 5.rar

Решение задачи: «Не работает цикл для вывода записей из Access в Excel»

textual
                            Листинг программы 
                        

                            RSset.novelast
RSset.movefirst
For I = 0 To RSset.RecordCount - 1
''''' действия
RSset.movenext
next i
                        