Importar planilha grande com 120.000 linhas

Estou tentando importar uma planilha de 120.000 linhas pra uma tabela do sql server via o programa em access. Mas ta muito lento, fica carregando por 30~60 minutos e depois dá erro.
Com planilha pequena dá certo.

O código é esse:

Código:

    Dim a As String
    Dim b As String
   
    a = "C:\Users\Nilson\Downloads\0\MATERIAIS\lx.xlsx"
   
    Dim strPathFile As String, strFile As String, strPath As String
    Dim strTable As String
    Dim blnHasFieldNames As Boolean
    blnHasFieldNames = True
    strPath = "C:" ' drive onde se situa o seu documento excel
    strTable = "dbo_lx" 'nome da tabela no seu banco
    'strFile = Dir(strPath & "temp.xls") 'nome do seu excel, se mudar para "*.xls" importa todas as folhas excel _
    'que estiverem em C:\ para a tabela do banco.
    strFile = Dir(a)

    Do While Len(strFile) > 0
        'strPathFile = strPath & strFile
        strPathFile = a
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
        strTable, strPathFile, blnHasFieldNames
        strFile = Dir()
    Loop

Peguei nesse link:

https://www.maximoaccess.com/t612-importar-dados-do-excel-para-o-access-dao

Olá, bom-dia!

Você já tentou debugar o programa em execução? Eu colocaria uma pausa dentro do loop para ver se o comportamento é o esperado.

1) antes de entrar no loop vc atribui o valor da variável strFile = Dir(a) e dentro do loop strFile = Dir() sem a variável "a" como parâmetro.
2) o comando para transfer para importar os dados está dentro do loop. Significa que ele importará vários arquivos ou várias planilhas?

Aparentemente está travando pq está executando coisas a mais dentro do loop

Amigão, há várias formas vou tentar descrever aqui. Uma delas é a seguinte:

1)Você deverá criar um tabela no Access como os campos que você deseja copiar os respectivos conteúdos do Excel.
2) criar um módulo com um Sub ou function para capturar os dados desejados
Por exemplo:
Sub Extrai_Dados()
End Sub

3) Depois você precisa criar um Recordset pra receber os conteúdos desejados
Sub Extrai_Dados()
Dim Ds As Recordset

Set Ds = CurrentDb.OpenRecordset("Nome Da Tabela Que Você Criou no ítem 1")

Ds.Close
Set Ds = Nothing
End Sub


4) Preparar o ambiente para abrir o Excel, o código vai ficar assim:
Sub Extrai_Dados()
Dim Ds As Recordset
Dim Excel As New Excel.Application
Dim i As Integer, j As Integer
Set Ds = CurrentDb.OpenRecordset("Nome Da Tabela Que Você Criou")

With Excel .Workbooks.Open "Endereço completo + nome do arquivo em Excel + extensão do arquivo"
.Visible = True
.WindowState = wdWindowStateMaximize
End With

Ds.Close
Set Ds = Nothing
End Sub


5) Agora, vc precisa saber qual a última linha e a última coluna que contém conteúdo no Excel, o código ficará desta forma;
Sub Extrai_Dados()
Dim Ds As Recordset
Dim Excel As New Excel.Application
Dim i As Integer, j As Integer
Dim ultLinha As Long, ultCol as Long

Set Ds = CurrentDb.OpenRecordset("Nome Da Tabela Que Você Criou")

With Excel .Workbooks.Open "Endereço completo + nome do arquivo em Excel + extensão do arquivo"
.Visible = True
.WindowState = wdWindowStateMaximize

ultLinha = .Sheets("NomeSuaPlanilha").Cells(1048576, 1).End(xlUp).Row
ultCol = .Sheets("NomeSuaPlanilha").Cells(1, 16384).End(xlToLeft).Colum


End With

Ds.Close
Set Ds = Nothing
End Sub

6) Finalizando, basta da 1ª linha até a ultima linha e da 1ª coluna até a última coluna e ir gravando os dados na tabela que vc criou no Access,
ficará assim:
Sub Extrai_Dados()
Dim Ds As Recordset
Dim Excel As New Excel.Application
Dim i As Integer, j As Integer
Dim ultLinha As Long, ultCol as Long

Set Ds = CurrentDb.OpenRecordset("Nome Da Tabela Que Você Criou")

With Excel .Workbooks.Open "Endereço completo + nome do arquivo em Excel + extensão do arquivo"
.Visible = True
.WindowState = wdWindowStateMaximize

ultLinha = .Sheets("NomeSuaPlanilha").Cells(1048576, 1).End(xlUp).Row
ultCol = .Sheets("NomeSuaPlanilha").Cells(1, 16384).End(xlToLeft).Colum
For i = 1 to ultLinha
For J = 1 to ultCol
Ds.AddNew
Ds!Campo1 = .Sheets("NomeSuaPlanilha").Cells(i, j)
...e assim sucessivamente
Next J
Next i

End With

Ds.Close
Set Ds = Nothing
End Sub

Espero ter ajudado. Se quiser mais ajuda, enviei o arquivo pra mim que eu lhe devolverei com o código adaptado para sua necessidade.
Meu e-mail é naxelsom@gmail.com