Вывод таблицы в Word посредством vba.

Public Sub WordA(SelectOrderID)
' Передача данных в Microsoft Word
' Описание рабочих переменных
Dim B, C, F, D, E
Dim a As Variant
Dim s$, i%
a = Date
' Объект Word
Dim oWord As Object
 
Dim DSset As ADODB.Recordset  ' Набор данных
Set DSset = New ADODB.Recordset
' Процедура находится в модуле ModuleSlave
' SelectDateTreaty - Дата
' DayMonthYear - Дата прописью
' Создание объекта MS Word
Set oWord = CreateObject("Word.Application")
' Сделать окно MS Word видимым
oWord.Visible = True
' Заголовок окна MS Word
oWord.Caption = "Заказ-наряд на проведение проверки качества "
oWord.Documents.Add
' Ориентация книжная бумага А4
' Поля (1 см = 28 пунктов)
With oWord.ActiveDocument.PageSetup
 .LineNumbering.Active = False
     .Orientation = wdOrientPortrait
     .LeftMargin = 48
     .RightMargin = 40
     .TopMargin = 56
     .BottomMargin = 56
End With
With oWord.ActiveDocument
     .AutoHyphenation = True
     .HyphenateCaps = True
     .ConsecutiveHyphensLimit = 0
End With
 
 
    With oWord.Selection
         .Font.Bold = True
         .Font.Name = "Times New Roman"
         .Font.Size = 11
         .ParagraphFormat.Alignment = wdAlignParagraphJustify
         .TypeText ("Заказ-наряд от " & a)
         .TypeParagraph
         .TypeText ("ООО Сервисный центр тел. +7 800 7707 888")
         .TypeParagraph
         .Font.Bold = False
         .Font.Size = 9
         .ParagraphFormat.Alignment = wdAlignParagraphJustify
         .TypeText ("Юридический адрес 143909, Московская область, г.Балашика, ул.Звездная, д.76, пом 418")
         .TypeParagraph
         .TypeText ("Адрес филиала: инд 195220 г. Санкт-Петербург пр. Науки 21 к.1")
         .TypeParagraph
         .Font.Underline = True
         .TypeText ("Основание: Расходная накладная от 29.05.2015")
         .TypeParagraph
         .Font.Bold = True
         .Font.Size = 11
         With DSset
            .Source = "SELECT OrderID, FamilyName, FirstName, SecondName, Object, Dates, DueDate, Cost, Phone " & _
            "FROM tblOrder " & _
            "WHERE OrderID = " & SelectOrderID
            .ActiveConnection = CurrentProject.Connection
            .CursorType = adOpenKeyset
            .Open
         
            D = !OrderID
            F = !FamilyName
            B = !FirstName
            C = !Phone
            E = "Покупатель: " & F & (" " + B)
         End With
    
    .TypeText (E)
    .TypeParagraph
    .Font.Bold = False
    .Font.Size = 9
    .Font.Underline = False
    .TypeText ("Сот. :" & C)
    DSset.Close
    End With
    
'======================================================================
'Пошла табличка:.
    oWord.Selection.TypeParagraph
 
    oWord.ActiveDocument.Tables.Add oWord.Selection.Range, 2, 4, 1, 0
    'oWord.ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:= _
        4, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
        
        With oWord.Selection.Tables(1)
            If .Style <> "Table Grid" Then
                .Style = "Table Grid"
            End If
            .ApplyStyleHeadingRows = True
            .ApplyStyleLastRow = False
            .ApplyStyleFirstColumn = True
            .ApplyStyleLastColumn = False
            .ApplyStyleRowBands = True
            .ApplyStyleColumnBands = False
        End With
          
        oWord.Selection.Tables(1).Columns(1).SetWidth ColumnWidth:=28.1, RulerStyle:= _
            wdAdjustFirstColumn
    
        oWord.Selection.Tables(1).Columns(2).SetWidth ColumnWidth:=63.8, RulerStyle:= _
            wdAdjustFirstColumn
    
        oWord.Selection.Tables(1).Columns(3).SetWidth ColumnWidth:=255.15, RulerStyle:= _
            wdAdjustFirstColumn
            
        
        oWord.Selection.TypeText Text:="№"
        oWord.Selection.MoveRight Unit:=wdCell
        oWord.Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
        oWord.Selection.Cells.Merge
        
        oWord.Selection.TypeText Text:="Наименование Товара"
        oWord.Selection.MoveRight Unit:=wdCell
        oWord.Selection.TypeText Text:="Серийный Номер"
 
        s = "SELECT * FROM Item WHERE OrderID=" & SelectOrderID
    
    
        With DSset
            .Source = s
            .ActiveConnection = CurrentProject.Connection
            .CursorType = adOpenKeyset
            .Open
             Do While Not .EOF '
                i = i + 1
                With oWord.Selection
                    .MoveRight 12 ' Unit:=wdCell
                    .TypeText CStr(i)
                    .MoveRight 12 ' Unit:=wdCell
                    .TypeText "123456789" '???? !!!!
                    .MoveRight 12 ' Unit:=wdCell
                    'Debug.Print DSset!ItemName
                    .TypeText CStr(DSset!ItemName)
                    .MoveRight 12 ' Unit:=wdCell
                    .TypeText "1234567890серийный" '???? !!!!
                End With
            .MoveNext
            Loop
            .Close
        End With
 
 
        oWord.Selection.MoveDown Unit:=wdLine, Count:=1
 
End Sub