Importar do Ms Excel e atualizar tabela

Segue uma rotina que acabei de fazer que faz a importação de uma planilha do Ms Excel para uma tabela do Ms Acess.

Não será preciso dizer que os campos da tabela e da planilha tem que serem iguais.

Será preciso criar uma tabela temporária em teu sistema para receber os dados da planilha.

Criar um botão de comando em um formulário e inserir o seguinte código.

Código:

'Desenvolvido por Silvio.
'31/05/2017
' Requer referencia a Microsoft Office 11 Object Library
   On Error GoTo PROC_ERR
  
   Dim fd As FileDialog
   Set fd = Application.FileDialog(msoFileDialogFilePicker)
  
   fd.Title = "selecione o arquivo"
   fd.Filters.Add "Arquivo XLS", "*.xls", 1  'se for o caso, mude a extensão para XLSX, onde estão xls

   fd.Show
  
   If (fd.SelectedItems.Count > 0) Then
       '------inicio importação excel para sincronização
       Dim strPathFile As String, strFile As String, strPath As String
       Dim strTable As String
       Dim blnHasFieldNames As Boolean
       blnHasFieldNames = True
       strPathFile = fd.SelectedItems(1)
       strTable = "TblPrepostoTmp" 'planilha temporária que vai receber os dados do MS Excel.[/color]
      
       'apaga temporários, não é necessário, mas por segurança estou limpando a tabela antes
       DoCmd.RunSQL "Delete * from TblPrepostoTmp"
      
       'importa para tabela local temporária
       DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strPathFile, blnHasFieldNames
       MsgBox "Registros importados com sucesso !" & vbCrLf & _
             "Atualizando registros de comissão", vbInformation, Me.Caption
              
              
        'Declaração das Variaveis
Dim DB As Database
Dim rs As DAO.Recordset ' TblPrepostoTmp - onde estão os dados que serão importados
Dim rs1 As DAO.Recordset ' tblacertocomissao -  para onde irão os dados a serem importados.


Set DB = CurrentDb()


   'Filtra os dados da tabela de Origem e Define a tabela de Destino dos dados.
   Set rs = DB.OpenRecordset("SELECT * FROM TblPrepostoTmp ")
   Set rs1 = DB.OpenRecordset("tblacertocomissao")


'Inicia a Gravação dos dados na Tabela de Destino (Dim rs1 As DAO.Recordset ' tblacertocomissao ) ,repete até COPIAR todos os Registros que foram selecionados
Do While Not rs.EOF
       'Inicia a Gravação dos dados na tblacertocomissao
       rs1.AddNew
       rs1("CodPed") = rs("CodPed")
       rs1("DataPed") = rs("DataPed")
       rs1("NossoPedido") = rs("NossoPedido") & " / " & rs("VendedorOculta")
       rs1("VendedorOculta") = rs("VendedorOculta")
       rs1("Cliente") = rs("Cliente")
       rs1("PrazoOculta") = rs("PrazoOculta")
       rs1("ValortotalPedido") = rs("ValortotalPedido")
       rs1("ForneOculta") = rs("ForneOculta")
       rs1("Efetivado") = rs("Efetivado")
       rs1.Update
   rs.MoveNext
   Loop

   'Ao Final Encerra as Conexões
   rs.Close
   rs1.Close
   DB.Close
      
       MsgBox "Operação concluída.", vbInformation, Me.Caption
      
       'apaga temporarios da tblprepostotmp que recebeu a importação.
       DoCmd.RunSQL "Delete * from TblPrepostoTmp"
      
   Else
       MsgBox "Não foi escolhido nenhum arquivo", vbInformation, Me.Caption

   End If
  
PROC_EXIT:
   Exit Sub
  
PROC_ERR:
   DoCmd.Hourglass False
   If Err.Number = 3011 Then
      LocalXML = ""
      MsgBox ("Arquivo inválido.")
   Else
       MsgBox Err.Description
   End If
   Resume PROC_EXIT

Bom proveito a todos, que tem essa dificuldade.

Abraços.

Obrigado pela partilha mestre Silvio!
É sempre bom ter à mão um exemplo destes.
Cumprimentos