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.
Bom proveito a todos, que tem essa dificuldade.
Abraços.
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.
Última edição por Silvio em 31/5/2016, 17:54, editado 2 vez(es) (Motivo da edição : adição de explicação)