Transportar vários dados do Excel para ACCESS de uma só vez

[Guima]

Ola Senhores,

Com a ajuda de vocês, principalmente do Jose e do Leandro eu consegui colocar os dados cadastrais da empresa onde trabalho no ACCESS e acessando pelo Excel. Porém, existem 2 fatores que gostaria de solicitar o auxilio de você novamente.

Recentemente meu chefe pediu para que pudéssemos inserir direto no ACCESS mais de um cadastro ao mesmo tempo. Exemplo. Transportar os dados da linha 2 até a linha 10 de uma só vez no banco Access. Há possibilidade de ser feito isso ?

E outra coisa, após mais ou menos um ano chegamos a quase 5 mil cadastros, e o banco tem ficado lento, ainda mais porque trabalhamos em rede. Existe alguma forma de otimizar isso ?

Abraço e obrigado novamente.

[Mikel Silveira Fraga]

Guima, boa noite.

Cara, em relação a situação de se enviar mais de 1 registro da planilha do Excel para um arquivo do Access, pode adaptar o código abaixo, onde fazia exatamente isso:

Código: Selecionar todos

Private Sub CommandButton1_Click()

    Dim cod, item, descr, und, dep As String
    Dim i, j, cod As Double
    Dim banco As ADODB.Connection
    Dim tabela As Recordset
    
    i = 2
    j = Plan1.Range("F1").Value + 1
    
    ' Esse modelo eu uso para conectar com o Banco de Dados MySQL, mas isso não influe no código principal.
    Set banco = CreateObject("ADODB.Connection")
    banco(0).Open "driver=mysql ODBC 5.1 Driver;server=localhost;database=balanca-ugv;uid=root;pwd=santher@00;"
    Set tabela = CreateObject("ADODB.RecordSet")
    Set tabela.ActiveConnection = banco

     ' É a partir daqui que entra o foco do laço de repetição.
 
    Do While Not Range("A" & i) = "" ' Nessa linha, o Do While vai se repetir, enquanto as celula selecionada da Coluna A não for vazia.
                                   
        cod = Range("A" & i).Value
        item = Range("B" & i).Value
        descr = Range("C" & i).Value
        und = Range("D" & i).Value
        dep = Range("E" & i).Value
               
        banco.Execute "INSERT INTO PRODUTOEMITENTE (COD_EMIT, COD_ITEM, DESCRICAO, UND, DEP) VALUES ('" & cod & "', '" & item & "','" & descr & "','" & und & "','" & dep & "')"
        
        i = i + 1
    
    Loop
    
    banco.Close
    
End Sub

Uma coisa importante é não se esquecer de habilitar a biblioteca Microsoft ActiveX Data Object 2.8 Library.

Em relação a uma forma de se utilizar essa quantidade de registros, sem pesar o processamento da planilha, te aconselharia a utilizar um banco de dados externo no lugar do Access.

Em uma das planilhas que desenvolvi no meu serviço, importei do sistema principal mais de 40000 cadastros de fornecedores, e o acesso a essas informações tinha uma variação de velocidade quase imperceptivel.

De uma estudada nesta possibilidade, pois existem bancos da dados com Lincenças OpenSource, não gerando nenhum tipo de situação ilegal com seu uso.

Espero ter ajudado. Abraços.

[Guima]

Ola Mikel !

Antes de qualquer coisa, MUITO OBRIGADO por sua ajuda !

Peço desculpas pela demora em responder, mas queria tentar fazer sozinho antes de pedir ajuda novamente. A minha necessidade é esta mesmo, mas não tive sucesso ao fazer as modificações. Aparece o seguinte erro: " Erro de Compilação. Número de argumentos incorreto ou atribuição de propriedade inválida.".

A rotina ficou igual a atua. Apenas coloquei meus dados e modifiquei a forma da conexão. Valendo dizer que habilitei a biblioteca que você citou.

Código: Selecionar todos

Private Sub CommandButton1_Click()

    Dim coldata, colemp, colcnpj, colseg, colnome As String
    Dim i, j, cod As Double
    Dim banco As ADODB.Connection
    Dim tabela As Recordset
    
    i = 2
    j = Workbooks("PLANILHA MODELO DE MAPEAMENTO.xlsm").Range("B1").Value + 1
    
    ' Esse modelo eu uso para conectar com o Banco de Dados MySQL, mas isso não influe no código principal.
    Set banco = CreateObject("ADODB.Connection")
    banco(0).Open ("\\Fileserver.bh01.local\dep com\DEPCOM_2011_Services\SDM\BDSDM.mdb")
   
    Set tabela = CreateObject("ADODB.RecordSet")
    Set tabela.ActiveConnection = banco

     ' É a partir daqui que entra o foco do laço de repetição.
 
    Do While Not Range("B" & i) = "" ' Nessa linha, o Do While vai se repetir, enquanto as celula selecionada da Coluna A não for vazia.
                                   
        coldata = Range("B" & i).Value
        colemp = Range("F" & i).Value
        colcnpj = Range("G" & i).Value
        colseg = Range("J" & i).Value
        colnome = Range("T" & i).Value
               
        banco.Execute "INSERT INTO tblCadastro (EMPRESA, CNPJ, DATA, NOME, SEGMENTO) VALUES ('" & colemp & "', '" & colcnpj & "','" & coldata & "','" & colnome & "','" & colseg & "')"
        
        i = i + 1
    
    Loop
    
    banco.Close
    
End Sub

[Mikel Silveira Fraga]

Guima, bom dia.

Cara, te passei um código incorreto. Na verdade eu utilizo esse código para importar para várias tabelas diferentes e por isso gerou o erro.

Faça a seguinte correção:

Código: Selecionar todos

banco(0).Open ("\\Fileserver.bh01.local\dep com\DEPCOM_2011_Services\SDM\BDSDM.mdb")

Para:

Código: Selecionar todos

banco.Open ("\\Fileserver.bh01.local\dep com\DEPCOM_2011_Services\SDM\BDSDM.mdb")

Veja se o problema se resolve desta forma.

E não se preocupe, pode chamar o quanto quiser.

Abraços.

[Guima]

Ola Mikel,

Infelizmente ainda não deu certo. O erro na conexão é que modificou.

Agora deu erro em tempo de execução. {Microsoft}{ODBC Drive Manager} Nome da fonte de dados muito longo

Brigadão mesmo pela disposição em me ajudar.

[Mikel Silveira Fraga]

Guima, bom dia.

Cara, eu tive umas suspeitas sobre esse erro quando o li e fiz alguns testes com um modelo parecido que tenho aqui.

Teria como vc enviar em anexo os arquivos (modelo) para que possa analisar esse código.

Abraços.

[Guima]

Ola Mikel,

Segue em anexo o modelo, conforme você pediu.

Mais uma vez agradeço sua disponibilidade.

[Mikel Silveira Fraga]

Guima, boa tarde.

Cara, não precisa agradecer. Estamos todos aqui para trabalharmos em equipe, um ajudando o outro... rsrsr.

Vamos ao seu problema. Na verdade eu ainda descrevi um código errado. Esses dias to numa correria e as vezes acabo fazendo as coisas sem ver direito.

A linha de código que te passei, esta errada. Faltou uma informação. Segue abaixo:
-Substitua:

Código: Selecionar todos

banco.Open ("\\Fileserver.bh01.local\dep com\DEPCOM_2011_Services\SDM\BDSDM.mdb")

Código: Selecionar todos

    Dim caminho as String

    caminho = "\\Fileserver.bh01.local\dep com\DEPCOM_2011_Services\SDM\BDSDM.mdb"

    banco.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & caminho

    'ou substitua esse comando acima pela linha que tem no módulo do seu arquivo.
    'banco.Open "Provider=Microsoft.ACE.oledb.12.0;Data Source=" & caminho
    'esse comando somente deve ser utilizado se no computador estiver instalado o Microsoft ACE Driver instalado.

Agora esta testado.

Abraços.

[Guima]

Sensacional Mikel !

Sem palavras para te agradecer, cara. Muito obrigado mesmo.

Grande abraço