Quantidade de registro limitado em uma tabela

Fiz uma tabela onde recebe os dados importados do excel, mas quando importo esses registros vem apenas uma quantidade limitada de 1400 linhas tenho uma quantidade de mais de 20 mil registros e não consigo importa-los, alquem me ajuda por favor, uso o código abaixo para fazer a importação do excel:

Option Compare Database

Private Sub btImportar_Click()
If IsNull(Me.txtTabela) Or IsNull(Me.txtlocalArquivo) Then
MsgBox "Seleciona a Tabela de Destino dos Dados e Localize a Planilha Excel!!!", vbCritical, "Erro"
Me.txtTabela.SetFocus
Me.txtTabela.Dropdown
Else
Dim strFile As String, strPath As String
Dim strTabela As String

strFile = Dir(Me.txtlocalArquivo) 'Pega o Nome do Arquivo
strPath = Me.txtlocalArquivo 'Pega o Local do Arquivo
strTabela = Me.txtTabela.Value

Do While Len(strFile) > 0
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTabela, strPath, True, Me.cboSheets & "!A1:AQ500"
strFile = Dir()

Loop
MsgBox "Importação efetuada com sucesso...", vbInformation
Me.txtTabela = Null
Me.txtlocalArquivo = Null
Me.cboSheets = Null
End If
End Sub



Private Sub btLocalizaRquivo_Click()
If IsNull(Me.txtTabela) Then
MsgBox "Seleciona a Tabela de Destino dos Dados!!!", vbCritical, "Erro"
Me.txtTabela.SetFocus
Me.txtTabela.Dropdown
Else

Dim JanelaDeProcura As Office.FileDialog
Set JanelaDeProcura = Application.FileDialog(msoFileDialogFilePicker)

With JanelaDeProcura
.Title = "Selecione a Planilha do Excel!!!"
.Filters.Clear
.Filters.Add "Excel Files", "*.xls*"

.FilterIndex = 2

.ButtonName = "Selecionar"
.InitialView = msoFileDialogViewDetails
.InitialFileName = CurrentProject.Path
If .Show = -1 Then
CaminhoDoFicheiro = CStr(JanelaDeProcura.SelectedItems.Item(1))
Else
Exit Sub
End If
End With

Me.txtlocalArquivo = CaminhoDoFicheiro
End If

End Sub

Private Sub cboSheets_GotFocus()
If IsNull(Me.txtlocalArquivo) Then
MsgBox "Selecione uma Arquivo Do Excel para listar as Planilhas", vbCritical, "Erro"
Me.btLocalizaRquivo.SetFocus

Else ' Carrega todas as Planilhas do arquivo Excel
Dim F As String
Dim appExcel As Excel.Application
Dim wb As Excel.Workbook
Dim sh As Excel.Worksheet
Set appExcel = CreateObject("Excel.Application")
Set wb = appExcel.Workbooks.Open(Me.txtlocalArquivo)
For Each sh In wb.Sheets
F = F & sh.Name & ";"
Next

Me.cboSheets.RowSource = F
wb.Close
appExcel.Quit
End If
End Sub

Private Sub txtTabela_GotFocus()
'Carrega todas as Tabelas do BD
Dim strData As String
Dim td As TableDef
For Each td In CurrentDb.TableDefs
If td.Attributes And dbSystemObject Then
'ignora as tabelas de sistema MSys*
Else
strData = strData & td.Name & ";"
End If
Next td

Me.txtTabela.RowSource = strData 'Aplica as tabelas na Combobox
End Sub

Desde já agradeço.

Olá, já testou a importação com a indicação do colega no topico abaixo:
https://www.maximoaccess.com/t26968-importar-do-excel
Acontece o mesmo?
Os utilizadores do fórum, merecem e agradecem o retorno.
Abraço

É exatamente esse que estou usando mas mesmo assim não consigo importar todos os registros que preciso.

Olá, para despistar, tente fazae assim:
1. No access ligar (vincular) à folha (sheet) do Excel.
2. No Access vai aparecee como uma tabela.
3. Criar uma consulta sobre a tabela migada do Excel, do tipo adicionar dados.
Abraço