Как перенести данные из таблицы ATable в Excel

Option Explicit
Sub TableToExcel()
Dim rCnt As Long
Dim iNdx As Long
Dim lngRow As Long
Dim lngCol As Long
Dim oent As AcadEntity
Dim tbl As AcadTable
Dim pt As Variant
Dim row As Long
Dim col As Long
Dim collTxt As New Collection
Set collTxt = New Collection
ThisDrawing.Utility.GetEntity oent, pt, vbCrLf & "Select table:"
If TypeOf oent Is AcadTable Then
Set tbl = oent
End If
With tbl
For row = 0 To .Rows - 1
ReDim tmp(0 To .Columns - 1)
For col = 0 To .Columns - 1
tmp(col) = .GetText(row, col)
Next col
collTxt.Add tmp
Next
End With
     '===================== excel part follows here============'
     Dim xlApp As Excel.Application
     Dim xlBook As Workbook
     Dim xlSheet As Worksheet
     Dim strFilePath As String
     On Error Resume Next
     Err.Clear
     Set xlApp = GetObject(, "Excel.Application")
     If Err <> 0 Then
          Err.Clear
          Set xlApp = CreateObject("Excel.Application")
          If Err <> 0 Then
               MsgBox "Cannot start Excel", vbExclamation
               End
          End If
     End If
     On Error GoTo 0
     xlApp.Visible = True
     Set xlBook = xlApp.Workbooks.Add
     Set xlSheet = xlBook.Worksheets(1)
     On Error GoTo Err_control
     rCnt = UBound(collTxt.Item(1))
     iNdx = 1
     With xlSheet
          .Range("A:A").NumberFormat = "@"
          For lngRow = 1 To collTxt.Count
               For lngCol = 1 To rCnt + 1
                    .Cells(lngRow, lngCol) = collTxt.Item(lngRow)(lngCol - 1)
                    iNdx = iNdx + 1
               Next
          Next
     End With
strFilePath = ThisDrawing.Path & "\ExportTable.xls"
xlBook.SaveAs strFilePath
MsgBox "Format cells manually" & vbCr & "then close Excel"
Err_control:
If Err.Number <> 0 Then
     MsgBox Err.Description
End If
End Sub