Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

VMCaetano

Inserindo dados do Excel no MS Access

Recommended Posts

Olá,

Estou fazendo um código que pega todos os dados de algumas colunas do excel e "escreve" esses dados em uma planilha do Access. Achei um código na internet que faz algo parecido com o que eu quero porém estou com dificuldades em adapta-lo para funcionar de maneira correta.

Sub conect()
    
    Dim db As ADODB.Connection ' c as adodb connection
    Dim rs As ADODB.Recordset ' rs as recordset
    Dim r As Long
    Dim myDB As String
    
    myDB = "C:\Users\Vinícius\teste.accdb"
    
    Set db = OpenDatabase(myDB)
    
    ' open the database
    Set rs = db.OpenRecordset("Rectbl", dbOpenTable)
    
    'get all records in a table
    r = 2 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0
    ' repeat until first empty cell in column A
    With rs
    .AddNew ' create a new record
    ' add values to each field in the record
    .Fields("ID") = Range("A" & r).Value
    .Fields("FullName") = Range("B" & r).Value
    .Fields("LastName") = Range("C" & r).Value
    .Fields("Location") = Range("D" & r).Value
    .Fields("Region") = Range("E" & r).Value
    .Update ' stores the new record
    End With
    r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
    
    MsgBox "Appended " & r - 1 & " Records to your database", vbOKOnly, "Confirmation"
    Range("A2:E200") = ""

End Sub

terei que alterar os campos "ID", "Lastname",..., bem como as colunas em que pegarei os dados para inserir no access.

 

Estou recebendo um erro que diz :

 

Erro de Compilação

'Sub' ou 'Function' não definida

 

E diz que o problema está em

  Set db = OpenDatabase(myDB)

Grato.

Compartilhar este post


Link para o post
Compartilhar em outros sites

troquei

Set db = OpenDatabase(myDB)

por

Set db = db.Execute(myDB)

mas ainda acho que vou ter que trocar o

Set rs = db.OpenRecordset("Rectbl", dbOpenTable)

existe algum comando que voce possa recomendar pra substituir o OpenRecordset ou não preciso me preocupar com ele?

Compartilhar este post


Link para o post
Compartilhar em outros sites

Então é VB6, acho que você não precisa muito se preocupar com o RecordSet não cara, se fosse .NET eu falaria pra usar DTables, mas no 6 é tranquilo.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Voltei das férias e fui pesquisar um pouco, acabei encontrando algumas outras maneiras.

 

    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset 
        
    
    strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\Vinícius\Documents\teste.accdb"
    
    Set cn = CreateObject("ADODB.Connection")
    
    cn.Open strCon

        
        Dim strSQL As Object
        
        scn = "[Excel 8.0;HDR=YES;DATABASE=C:\Users\Vinícius\Documents\teste.accdb" & ActiveWorkbook.FullName & "]"
        Set strSQL = "INSERT INTO IP" _
                    & "SELECT * FROM [Excel 8.0;HDR=YES,DATABASE=C:\Users\Vinícius\Documents\teste2.xlsm].[Sheet1$]"
        
        
        Set rs = cn.Execute(strSQL)
        
        
    
        rs.Close
        cn.Close
        Set cn = Nothing

O excel diz que existe um erro de compilação e que o & que esta dentro do Set strSQL é incompatível

Set strSQL = "INSERT INTO IP" _
                    & "SELECT * FROM [Excel 8.0;HDR=YES,DATABASE=C:\Users\Vinícius\Documents\UFMT\ELETRONORTE\GeradorIP Excel\ELN.xlsm].[Sheet1$]"

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Resolvi da seguinte maneira

 

    Dim cn As ADODB.Connection 'define c como conexão entre excel e o banco de dados do access
    Dim rs As ADODB.Recordset ' define rs como recordset
    Dim strCon As String, scn As String
    
    Dim ws As Worksheet
    Dim rng As Range
    
    Set ws = ActiveWorkbook.Worksheets("Plan1")
    Set rng = ws.Range(Cells(2, 4), Cells(22, 4))
    
    strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\Vinícius\Documents\teste.accdb"
    
    Set cn = CreateObject("ADODB.Connection")
    
    cn.Open strCon

        
        Dim strSQL As String
        ' Inserindo IPs gerados no Access
        scn = "[Excel 8.0;HDR=YES;DATABASE=C:\Users\Vinícius\Documents\teste.accdb" & ActiveWorkbook.FullName & "]"
        strSQL = "INSERT INTO IP (IP) values (""" & rng(1, 1).Value & """)"
                  
        MsgBox strSQL
        ' Executa a instrução
        Set rs = cn.Execute(strSQL)
        
        ' Fechando a conexão
    
        
        Set rs = Nothing
        cn.Close
        Set cn = Nothing

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.