IMPORTAR DADOS DO EXCEL PARA TABELA DO ACCESS

USUARIO.EXCLUIDOS 11/12/2006 09:13:06
#189211
Como faço para importar os registros do Excel para uma tabela do Access 97 usando o Visual Basic 6? Só que os registros do Excel teriam que ir para campos especificos na tabela do Access ou seja eu teria que informar para quais campos cada coluna do Excel teria que ser exportado os regsitros.

Exemplo:

Localizar qual seria o campo "Descrição" no Excel e exportar para o devido campo na tabela do Access. Localizar o campo "Preço" no Excel e exportar para o devido campo no Access e assim sucessivamente com todos os campos necessários.
USUARIO.EXCLUIDOS 11/12/2006 09:46:23
#189231
Vc pode abrir um Rs apontando uma conexão para o XLS
Ae então vc pode criar outra conexão com um Access e ficar inserindo item a item do Excel nos campos que desejar

Resumindo:

Precisa de 2 conexões , 1 com o Excel para fazer o select e outra com o Access para Inserts

Precisa de um RecordSet com os registros do Excel para percorrê-lo e inserir um a um no Access pela Conexão com o Access

Se não souber fazer o código poste ae, vlw.
SPRITU 11/12/2006 10:55:21
#189246 Resposta escolhida 
  '---------------------------------------------------------------------------------------
' Procedure : Import
' DateTime  : 8/12/2006 15:39
' Author    : SOUZAEST
' Purpose   : Fazer leitura de planilha do excel e importar para tabela access
'---------------------------------------------------------------------------------------
'
[c]Public Function Import(lpFilename As String)
      
    Dim Recordset As New ADODB.Recordset 'cria o ponteiro
    Dim SQLString As String 'variavel para o sql

    'verifica o path ================================================
    If CheckFile(lpFilename) = False Then
        MsgBox "Não foi possível importar os dados!", vbInformation
        Exit Function
    End If
    '================================================================
    
    
    'verificação se ja existe uma conexão ===========================================
    If Connection.State = 0 Then 'se nao existir cria ===============================
        Connection.Provider = "Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0"
        Connection.Open lpFilename
    End If
    '================================================================================

    'seta o comando em sql ==========================================================
    SQLString = "SELECT * FROM [Format$]"
    '================================================================================
    
    'mostra a tela com o status ====================================================
    frmImport.Show
    
    
    'prepara o recordset para executar a leitura ====================================
    Recordset.CursorType = adOpenForwardOnly
    Recordset.LockType = adLockReadOnly
    Recordset.CursorLocation = adUseClient
    '================================================================================
        
        'executa o comando sql ======================================================
        Recordset.Open SQLString, Connection
        '============================================================================
        
        'verifica se existi algum registro na tabela ================================
        If Recordset.BOF And Recordset.EOF Then
            'mostra o erro se nao existir
            MsgBox "Não existe dados a serem importados!", vbCritical
            
                'fecha a conexao e o ponteiro
                If Connection.State = 1 Then Connection.Close
                If Recordset.State = 1 Then Recordset.Close
                
                'destroy o objeto
                Set Recordset = Nothing
                
                'sau da função
                Exit Function
                
        End If
        '============================================================================
        
        'verifica se o nº de campos bate com o original =============================
        If Recordset.Fields.Count <> 19 Then
                
                'mostra erro
                MsgBox "Planilha está inválida!, os campos nao conferem!", vbCritical
                
                'fecha a conexao e o ponteiro
                If Connection.State = 1 Then Connection.Close
                If Recordset.State = 1 Then Recordset.Close
                
                'destroy o objeto
                Set Recordset = Nothing
                
                'sai da função
                Exit Function
                
        End If
        '===========================================================================
        
        'retorna a propriedade Records da Classe ==================================
        lngRecords = Recordset.RecordCount - 1
        '==========================================================================
        
        'verifica se nao tem nada no texto e corre pra proxima linha se tiver
        If Recordset("Texto breve") = "" And Recordset.RecordCount > 1 Then
            Recordset.MoveNext 'vai para a proxima
        End If
        
        'redimensiona a variavel para o valor do nº de registros
        ReDim ReqLines(1 To Recordset.RecordCount - 1)
        
            'inicia o loop de contagem
            For i = 1 To Recordset.RecordCount - 1
        
            DoEvents
             
            'retorna a propriedade State
            strState = "Carregando Registros..."
            '========================================================
            

            
            With ReqLines(i) 'linha de rc
            
                .rcAccompText = Recordset(15) 'nº acompanhamento
                .rcCodMaterial = Recordset(3) 'codigo do material
                .rcConta = Recordset(17) 'numero da conta
                .rcCostCenter = Recordset(16) 'centro de custo
                .rcDataSys = Date 'data em que esta entrando no sistema
                .rcEmissionDate = Recordset(10) 'data de emissao da rc
               
                
                If IsNull(Recordset(0)) = False Then 'caso nao seja nulo
                    .rcNumber = Recordset(0) 'numero da rc
                Else
                    .rcNumber = LastRc 'numero da rc anterior
                End If
                
                If IsNull(Recordset(11)) = False Then 'caso nao seja nulo
                    .rcPurchaseOrder = Recordset(11) 'numero da oc
                End If
                
                If IsNull(Recordset(18)) = False Then 'caso nao seja nulo
                    .rcInvoiceNumber = Recordset(18) 'numero da nota 'numero da nota
                End If
                
                .rcValue = CCur(Recordset(8))
                .rcSupplier = Recordset(12) 'nome do fornecedor
                .rcText = Recordset(5) 'texto breve
                .rcUser = Me.User 'seta o usuario atual
                .rcPeriod = Me.Period 'periodo fornecido pela outra dll
                .rcDeliveryDate = CDate(Recordset(13))
                
                'coloca os status nas rcs
                    If Recordset(4) = "L" Then 'caso L =Comercial, senao Aprovação
                        .rcStatus = "Comercial" 'status comercial
                    Else
                        .rcStatus = "Aprovação" 'status em aprovação
                    End If
                    
                    'configurações para definir o status da requisição
                    If .rcPurchaseOrder <> "" And .rcDeliveryDate > Date Then
                        .rcStatus = "Aguardando Chegada"
                    ElseIf .rcPurchaseOrder <> "" And CDate(.rcDeliveryDate) <= Date Then
                        .rcStatus = "Prazo Expirado"
                    ElseIf .rcPurchaseOrder <> "" And .rcDeliveryDate = 0 Then
                        .rcStatus = "Prazo Expirado"
                    ElseIf .rcPurchaseOrder = "" And .rcDeliveryDate <> 0 Then
                        .rcDeliveryDate = 0
                    End If
                    
                    'caso tenha numero de nota esta concluido
                    If .rcInvoiceNumber <> "" Then
                        .rcStatus = "Concluido"
                    End If
                        
                        'caso a grava a ultima rc na variavel
                        'para caso a proxima nao exista
                        'usa a anterior
                        
                        LastRc = .rcNumber
    
                End With
                
                'corre o cursor
                Recordset.MoveNext
                
                'retorna o percentual ja percorrido
                Percent = CInt((i / (Recordset.RecordCount - 1)) * 100)
                
                Sleep 0.001 'descansa o tempo
            
            
            'atualiza os valores na caixinha de status
                With frmImport
                    .pBar.Max = 100
                    .pBar.Value = Percent
                    .lblPercent.Caption = Percent & "%"
                    .lblstate = i & "/" & Recordset.RecordCount - 1
                End With
                

            Next i 'roda o contador
            
            'destroy os componentes
            If Recordset.State = 1 Then Recordset.Close
            If Connection.State = 1 Then Connection.Close
            
            'fecha o form de status
            Unload frmImport
            
            Connection.Provider = "Microsoft.Jet.OLEDB.4.0"
            Connection.CursorLocation = adUseClient
            Connection.Open App.Path & "/db2.mdb"
            
            Recordset.CursorLocation = adUseClient
            Recordset.LockType = adLockOptimistic
            Recordset.CursorType = adOpenDynamic
            
            frmImport.Show
            

            
            For i = 1 To UBound(ReqLines)
            
            DoEvents
                
            SQLString = "SELECT * FROM Reqs WHERE rcNumber='" & ReqLines(i).rcNumber & "' AND rcText='" & ReqLines(i).rcText & "'"
                
                If Recordset.State = 1 Then Recordset.Close
                    Recordset.Open SQLString, Connection
                
                If Recordset.BOF And Recordset.EOF Then
                                    
                Recordset.AddNew
                
                    With Recordset
                        .Fields("rcEmissionDate") = ReqLines(i).rcEmissionDate
                        .Fields("rcDeliveryDate") = ReqLines(i).rcDeliveryDate
                        .Fields("rcInvoiceNumber") = ReqLines(i).rcInvoiceNumber
                        .Fields("rcConta") = ReqLines(i).rcConta
                        .Fields("rcCostCenter") = ReqLines(i).rcCostCenter
                        .Fields("rcNumber") = ReqLines(i).rcNumber
                        .Fields("rcPurchaseOrder") = ReqLines(i).rcPurchaseOrder
                        .Fields("rcSupplier") = ReqLines(i).rcSupplier
                        .Fields("rcText") = ReqLines(i).rcText
                        .Fields("rcCodMaterial") = ReqLines(i).rcCodMaterial
                        .Fields("rcValue") = ReqLines(i).rcValue
                        .Fields("rcStatus") = ReqLines(i).rcStatus
                        .Fields("rcDataSys") = ReqLines(i).rcDataSys
                        .Fields("rcUser") = ReqLines(i).rcUser
                        .Fields("rcAccompText") = ReqLines(i).rcAccompText
                        .Fields("rcPeriod") = ReqLines(i).rcPeriod
                    End With
                    
                Recordset.Update
                
                Else
                
                     With Recordset
                        .Fields("rcEmissionDate") = ReqLines(i).rcEmissionDate
                        .Fields("rcDeliveryDate") = ReqLines(i).rcDeliveryDate
                        .Fields("rcInvoiceNumber") = ReqLines(i).rcInvoiceNumber
                        .Fields("rcConta") = ReqLines(i).rcConta
                        .Fields("rcCostCenter") = ReqLines(i).rcCostCenter
                        .Fields("rcNumber") = ReqLines(i).rcNumber
                        .Fields("rcPurchaseOrder") = ReqLines(i).rcPurchaseOrder
                        .Fields("rcSupplier") = ReqLines(i).rcSupplier
                        .Fields("rcText") = ReqLines(i).rcText
                        .Fields("rcCodMaterial") = ReqLines(i).rcCodMaterial
                        .Fields("rcValue") = ReqLines(i).rcValue
                        .Fields("rcStatus") = ReqLines(i).rcStatus
                        .Fields("rcDataSys") = ReqLines(i).rcDataSys
                        .Fields("rcUser") = ReqLines(i).rcUser
                        .Fields("rcAccompText") = ReqLines(i).rcAccompText
                        .Fields("rcPeriod") = ReqLines(i).rcPeriod
                    End With
                    
                Recordset.Update
                
                End If
                
                'retorna o percentual ja percorrido
                Percent = CInt((i / (UBound(ReqLines))) * 100)
                
                Sleep 0.001 'descansa o tempo
                'atualiza os valores na caixinha de status
                
                With frmImport
                    .pBar.Max = 100
                    .pBar.Value = Percent
                    .lblPercent.Caption = Percent & "%"
                    .lblstate = i & "/" & UBound(ReqLines())
                    .Caption = "Salvando..."
                End With

            Next i
            
            'mostra a mensagem na tela
            MsgBox "Os Registros foram importados com sucesso!", vbInformation
            
            'fecha o form
            Unload frmImport
            
            'clear na variavel para esvazia memoria
            ReDim ReqLines(0)
            
            'sai da rotina
            Exit Function
            
            
ErrHand:
        'mostra a mensagem na tela
        MsgBox "Ocorreu um erro importando os registros", vbCritical
        
            
End Function

[/c]
USUARIO.EXCLUIDOS 11/12/2006 15:50:40
#189333
Me perdoe a ignorancia, mas como faço para usar esta rotina?
USUARIO.EXCLUIDOS 11/12/2006 19:54:43
#189390
Ctrl+C >> Ctrl+V

O cara te entregou de bandeija toda a codificação exatamente como eu havia descrito que precisaria fazer.

'---------------------------------------------------------------------------------------
' Procedure : Import
' DateTime : 8/12/2006 15:39
' Author : SOUZAEST
' Purpose : Fazer leitura de planilha do excel e importar para tabela access
'---------------------------------------------------------------------------------------
'
[c]Public Function Import(lpFilename As String)
lpFilename é o seu arquivo excel

Connection.Open App.Path & "/db2.mdb"
App.Path & "/db2.mdb" é o caminho + o nome do arquivo .mdb

Pelo amor de Deus não vá pedir também para ensinar a criar um mdb.

Existem sim rotinas de verificação (if's) que infelizmente vc vai ter de depurar para retirar o que vc não precisa.

Resumindo, o cara te ajudou muito pq vc precisa só escluir código para fazer o que quer e não escrever um pouco mais em cima !!!
USUARIO.EXCLUIDOS 12/12/2006 10:16:22
#189477
Está dando erro nesta linha: SQLString = "SELECT * FROM [Format$]" dá a seguinte mensagem: 'Format$' não é um nome válido. Certifique-se de que ele inclua somente caracteres ou pontuação válidos e de que não seja longo demais.
USUARIO.EXCLUIDOS 12/12/2006 21:42:40
#189594
Não testei, mas experimente substituir pelo nome de sua planilha ou do seu arquivo .xls
USUARIO.EXCLUIDOS 13/12/2006 08:04:29
#189622
Coloquei das seuintes formas:

SQLString = "SELECT * FROM [C:\SGI\Texto\Tabela_de_Produtos.xls]"

SQLString = "SELECT * FROM C:\SGI\Texto\Tabela_de_Produtos.xls"

SQLString = "SELECT * FROM [Tabela_de_Produtos.xls]"

E nenhuma deu certo da a seguinte mensagem: "O mecanismo de banco de dados Jet não pode encontrar o objeto 'C:\SGI\Texto\Tabela_de_Produtos.xls'. Certifique-se de que o objeto exista e de ter digitado seu nome e o caminho corretamente"

Obs.: Conferi mais de uma vez e a planilha Excel existe e o caminho esta correto.
USUARIO.EXCLUIDOS 13/12/2006 08:33:32
#189625
Tenta isso:
SQLString = "SELECT * FROM [Nome da TABELA$]"

Por exemplo:
Na minha planilha Tabela_de_Produtos.xls eu tenho a tabela chamada Plan1.

Ai eu teria o meu select assim:

SQLString = "SELECT * FROM [Plan1$]"

Não esqueça de usar o $ no final.

Falow
SPRITU 13/12/2006 17:38:03
#189807
Citação:

QUESADA escreveu:
Tenta isso:
SQLString = [Ô]SELECT * FROM [Nome da TABELA$][Ô]

Por exemplo:
Na minha planilha Tabela_de_Produtos.xls eu tenho a tabela chamada Plan1.

Ai eu teria o meu select assim:

SQLString = [Ô]SELECT * FROM [Plan1$][Ô]

Não esqueça de usar o $ no final.

Falow



Desculpe eu nao ter falado isso, mas a resposta é essa mesma, é o nome da Sheet, no meu caso a "aba" (tabela) chama format$, mas no seu caso pode ser Plan1$ ou Sheet1$ etc...

malz ai por nao ter falado
USUARIO.EXCLUIDOS 14/12/2006 08:26:18
#189862
E o que são esses itens da onde vem?

.rcAccompText = Recordset(0) 'nº acompanhamento
.rcCodMaterial = Recordset(3) 'codigo do material
.rcConta = Recordset(17) 'numero da conta
.rcCostCenter = Recordset(16) 'centro de custo
.rcDataSys = Date 'data em que esta entrando no sistema
.rcEmissionDate = Recordset(10) 'data de emissao da rc

O recordset faz referencia aos campos na planilha e os campos: "rcAccompText", "rcCodMaterial" são apra armazenar o valor?
Quando executo da erro na seguinte linha:

.rcAccompText = Recordset(0)

Diz que o objeto é obrigatório
Página 1 de 2 [14 registro(s)]
Tópico encerrado , respostas não são mais permitidas
Voltar