Transferência de Dados do Excel para o Access usando o Access

boa noite!

Galera, venho tentando criar um banco de dados para "puxar" dados de uma planilha de excel com o access, porém após muitas tentativas fazer o código funcionar restando somente fazer duas coisas:

1º Ao rodar o código a planilha do Excel fica aberta e ao tentar abrir esta planilha a mesma fica em "oculto" e não abre;
2º em um outro momento ela da um erro e as vezes chega até travar.

Acredito que eu não tenha colocado da melhor forma os objetos e devido a isso causando estes empecilhos no processo de transferência de dados.

Vou deixar em anexo o banco de dados e se puderem me ajudar ficarei muito grato.

-Banco de dados chamado bd_dados;
-planilha chamada teste2.xlsx.

No momento não tenho a planilha teste2.xlsx mas caso queiram fazer algum teste, deixa somente 1 linha de comando de transferência e cria uma igual ok?

Muito obrigado a quem puder ajudar!

Amigo, seja bem vindo ao Forum!

Ja verificou os Excelentes exemplos que tempos aqui no Fórum?

Lhe recomendarei dois feitos por mim e que utilizo sempre e nao tive problemas ainda...

https://www.maximoaccess.com/t27311-importar-dados-planilha-excel-e-desmembrar-os-dados-em-duas-tabelas-tbpessoa-e-tbendereco

'Esse aqui é mais completo...
https://www.maximoaccess.com/t26911-importar-planilha-excel-informando-a-tabela-de-destino-a-folha-sheets-de-origem-e-localizando-o-documento-excel


Obs: Faltou seu Anexo!

Nao estou conseguindo postar a planilha aqui, mas olha postei ele no onedrive

https://1drv.ms/u/s!Al6bC5FwGaP7ghcFV0TWE4zdAuLc (está em .rar e não é virus pode confiar)

caso queira também, estou deixando o codigo abaixo, e a planilha teste2.xlsx contem os dados que estou comparando, ok?agradeço pela força amigo

Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Global banco As Database
Global consulta As Dao.Recordset
Sub Comando0_Click()
Dim objXLApp As New Excel.Application
Dim ComandoSQL As String
Dim linha As String
Dim oApp As Object
Dim objXLSheet As Excel.Worksheet
Dim objXLBook As Excel.Workbook

'Se atribuir True, a janela do Excel aparecerá


Set objXLBook = objXLApp.Workbooks.Open("C:\Users\m206519\Desktop\teste2.xlsx")

Set objXLSheet = objXLBook.Worksheets("dados")

objXLSheet.Range("A2").Select

objXLBook.Windows(1).Visible = True


'lopping das linhas
Do While objXLApp.ActiveCell <> ""

linha = objXLApp.ActiveCell.Row

Set banco = CurrentDb

'Armazena na variável o comando que fará a consulta SQL no BD Access
ComandoSQL = "select * from Tabela1"

'Atribui a variável de Objeto de BD a execução dos comandos SQL
Set consulta = banco.OpenRecordset(ComandoSQL)

With consulta
'Abre o Recordset do BD para inserção
.AddNew

.Fields("Nota APTR Liberada") = objXLApp.Sheets("dados").Cells(linha, 1) 'ID
.Fields("Empreendedor") = Sheets("dados").Cells(linha, 2) 'nome
.Fields("Nome do Empreendimento") = Sheets("dados").Cells(linha, 3) 'sobrenome
.Fields("Endereço da Obra") = Sheets("dados").Cells(linha, 4) 'cpf
.Fields("Localidade") = Sheets("dados").Cells(linha, 5)
.Fields("Grp plnj PM") = Sheets("dados").Cells(linha, 6) 'rg
.Fields("Início desejado") = Sheets("dados").Cells(linha, 7) 'endereço
.Fields("APTR Liberada Rejeitada") = Sheets("dados").Cells(linha, 'numero
.Fields("Análise de Servidão de Passagem Data") = Sheets("dados").Cells(linha, 9) 'cidade
.Fields("Solicitação de Tombamento") = Sheets("dados").Cells(linha, 10) 'UF
.Fields("Nota IS Projeto de Incorporação de Rede") = Sheets("dados").Cells(linha, 11)
.Fields("Projeto de Incorporação DDR1") = Sheets("dados").Cells(linha, 12)
.Fields("Projeto de Incorporação DDR2") = Sheets("dados").Cells(linha, 13)
.Fields("Nota INEP de Aprovação") = Sheets("dados").Cells(linha, 14)
.Fields("Nota IRDP") = Sheets("dados").Cells(linha, 15)
.Fields("Projeto de Interligação") = Sheets("dados").Cells(linha, 16)
.Fields("Processo IR") = Sheets("dados").Cells(linha, 17)
.Fields("Coordenação Responsável") = Sheets("dados").Cells(linha, 18)
.Fields("Tipo de Rede Interna - Aerea, Subterrânea ou Mista") = Sheets("dados").Cells(linha, 19)
.Fields("Energizado Em") = Sheets("dados").Cells(linha, 20)
.Fields("Orçamento ELPA Projeto PLM Aéreo") = Sheets("dados").Cells(linha, 21)
.Fields("Orçamento ELPA Projeto PLM Subterrâneo Concluído") = Sheets("dados").Cells(linha, 22)
.Fields("Servidão ou Ofício") = Sheets("dados").Cells(linha, 23)
.Fields("Notas Fiscais") = Sheets("dados").Cells(linha, 24)
.Fields("Notas projeto CM ou LN") = Sheets("dados").Cells(linha, 25)
.Fields("Status") = Sheets("dados").Cells(linha, 26)
.Fields("Contrato de incorporação") = Sheets("dados").Cells(linha, 27)
.Fields("Contrato de Obra interligação") = Sheets("dados").Cells(linha, 28)
.Fields("Encaminhado a Gestão de Ativos em") = Sheets("dados").Cells(linha, 29)
.Fields("Encaminhado a Controladoria em") = Sheets("dados").Cells(linha, 30)



'Se houver erro
On Error Resume Next

'Efetiva a atualização do BD
.Update

'Fecha o Recorset e a conexão com o BD
consulta.Close
banco.Close

'Chama a rotina que desconecta do BD (libera variáveis objeto de BD)
Call Desconecta

ActiveCell.Offset(1, 0).Select


End With

Loop



'Exibe mensagem de sucesso na inclusão do registro
MsgBox "Dados transferidos com Sucesso! ", vbDefaultButton1, "Transferência"


'Abandona a subrotina
Exit Sub

objXLBook.Save
'Fecha nova instância
objXLApp.Quit
'Quebra as referênciasSet
Set objXLSheet = Nothing
Set objXLBook = Nothing
Set objXLApp = Nothing

End Sub