importação de registros

Moderador: Avelino Sampaio

wesley
Mensagens: 18
Registrado em: 07 Jun 2015, 02:44

importação de registros

Mensagempor wesley » 08 Jun 2015, 19:24

olá pessoal, gostaria de saber se é possivel fazer uma importação de registro de uma tabela mysql para um tabela access, conforme o esquema que seguem.
figura.jpg
Você deve estar registrado e autenticado para ter acesso ao arquivo anexo.

Disable adblock

Precisamos do seu apoio. Faca uma doacao para o site atraves do Paypal.


Avelino Joao
Mensagens: 7
Registrado em: 07 Jun 2015, 13:30

Re: importação de registros

Mensagempor Avelino Joao » 08 Jun 2015, 20:32

Testa esse código!


Código: Selecionar todos

Function importar_Produto()
Dim Db2 As Database
Dim Rs2 As Recordset
On Error Resume Next
dataset.Close 'fecha o recorset
banco.Close 'fecha o banco de dados
Set dataset = Nothing
Rs2.Close
Set Db2 = Nothing
Set Db2 = CurrentDb
On Error GoTo trata

Comando = "Select codProduto,descricao,unidade,valorUnitario,estoqueMinimo,qtdEstoque,estado,iva,tabelaiva  from produto WHERE codProduto=" & Nz(Me!txtcod) & " ORDER BY codProduto;"
Call executa

dataset.MoveFirst
Set Rs2 = Db2.OpenRecordset("Produto")
Do While Not dataset.EOF
Rs2.AddNew
If IsNull(dataset!codProduto) = True Or dataset!codProduto = "" Then
Else
Rs2!codProduto = dataset!codProduto
End If
If IsNull(dataset!descricao) = True Or dataset!descricao = "" Then
Else
Rs2!descricao = dataset!descricao
End If
If IsNull(dataset!unidade) = True Or dataset!unidade = "" Then
Else
Rs2!unidade = dataset!unidade
End If
If IsNull(dataset!valorUnitario) = True Or dataset!valorUnitario = "" Then
Else
Rs2!valorUnitario = dataset!valorUnitario
End If
If IsNull(dataset!qtdEstoque) = True Or dataset!qtdEstoque = "" Then
Else
Rs2!qtdEstoque = dataset!qtdEstoque
End If
If IsNull(dataset!estoqueMinimo) = True Or dataset!estoqueMinimo = "" Then
Else
Rs2!estoqueMinimo = dataset!estoqueMinimo
End If
If IsNull(dataset!estado) = True Or dataset!estado = "" Then
Else
Rs2!estado = dataset!estado
End If

If IsNull(Rs2!IVA) = True Or Rs2!IVA = "" Then
Else
rs!IVA = Rs2!IVA
End If
If IsNull(Rs2!tabelaiva) = True Or Rs2!tabelaiva = "" Then
Else
rs!tabelaiva = Rs2!tabelaiva
End If
Rs2.Update
dataset.MoveNext
Loop
dataset.Close
cn.Close
Set dataset = Nothing
Rs2.Close
Set Db2 = Nothing
sai:
Exit Function
trata:
If Err = 3021 Then
Resume Next
Else
Set dataset = Nothing
Resume sai
End If
End Function

Código: Selecionar todos

Function Exportar_DetalheVenda()
Dim Db2 As Database
Dim Rs2 As Recordset

On Error Resume Next
rs.Close 'fecha o recorset
cn.Close 'fecha o banco de dados
Set rs = Nothing

Rs2.Close
Set Db2 = Nothing

Set Db2 = CurrentDb
On Error GoTo trata
Call MySQL_Server
cn.Open "Driver={MySQL ODBC 5.5.25a Driver};Server=" & MyslqServidor & ";Database=" & MyslqDatabase & ";User=" & MyslqUsuario & "; Password=" & MyslqSenha & ";Option=3;"
rs.CursorLocation = adUseClient

rs.Open "Select codVenda,codProduto,qtdProduto,iva,tabelaiva " & _
            "From detalhevenda ", cn, adOpenDynamic, adLockOptimistic

           
Set Rs2 = Db2.OpenRecordset("DetalheVenda")

Do While Not Rs2.EOF
rs.AddNew

If IsNull(Rs2!codVenda) = True Or Rs2!codVenda = "" Then
Else
rs!codVenda = Rs2!codVenda
End If

If IsNull(Rs2!codProduto) = True Or Rs2!codProduto = "" Then
Else
rs!codProduto = Rs2!codProduto
End If

If IsNull(Rs2!qtdProduto) = True Or Rs2!qtdProduto = "" Then
Else
rs!qtdProduto = Rs2!qtdProduto
End If
If IsNull(Rs2!IVA) = True Or Rs2!IVA = "" Then
Else
rs!IVA = Rs2!IVA
End If
If IsNull(Rs2!tabelaiva) = True Or Rs2!tabelaiva = "" Then
Else
rs!tabelaiva = Rs2!tabelaiva
End If
rs.Update

Rs2.MoveNext
Loop

rs.Close
cn.Close
Set rs = Nothing

Rs2.Close
Set Db2 = Nothing

sai:
Exit Function

trata:

If Err = 3021 Then
Resume Next

Else
Set rs = Nothing

Resume sai
End If
End Function


Código: Selecionar todos

Public Sub executa()
   'inicializa o dataset, executa o comando sql passado através da variavél Comando e preenche o dataset na memória
  If banco.State = 1 Then    'verificar o status do banco de dados. Se aberto fecha a conexão
        banco.Close
    End If

    If dataset.State = 1 Then    'verificar o status do recordeset. Se aberto fecha a conexão
        dataset.Close
    End If
    Call MySQL_Server    'Carrega parametros do servidor
    banco.Open "Driver={MySQL ODBC 5.5.25a Driver};Server=" & MyslqServidor & ";Database=" & MyslqDatabase & ";User=" & MyslqUsuario & "; Password=" & MyslqSenha & "; Port=" & MyslqPorta ''& ";Option=3;"
   dataset.CursorLocation = adUseClient
   dataset.Open Comando, banco, adOpenDynamic, adLockOptimistic
End Sub
'---------------------------------------------------------------------------------------
'  PROCEDIMENTO: MySQL_Server
'     DESCRIÇÃO: Carrega os dados para conexão ao servidor MySQL
'---------------------------------------------------------------------------------------
Public Sub MySQL_Server()

    If sErr = -1 Then    'Habilita tratamento de erro
        On Error GoTo MySQL_Server_Erro
    End If
    MyslqServidor = DLookup("[Servidor]", "Servidor", "[ID]=18")    'Servidor Web
    MyslqUsuario = DLookup("[USServer]", "Servidor", "[ID]=18")    'Usuário do banco de dados
    MyslqSenha = DLookup("[PWServer]", "Servidor", "[ID]=18")    'Senha do banco de dados
    MyslqDatabase = DLookup("[DbServer]", "Servidor", "[ID]=18")    'Database
    MyslqPorta = DLookup("[Port]", "Servidor", "[ID]=18")    'Porta source
    Source = DLookup("[source]", "Servidor", "[ID]=18")    'fonte

    On Error GoTo 0
    Exit Sub

MySQL_Server_Erro:
    DoCmd.Hourglass False
    MsgBox "Ocorreu um erro na aplicação." & vbCr & "Relate os dados abaixo ao suporte." & vbCr & _
           "Descrição do erro: " & Err.Description & vbCr & _
           "Módulo: " & "Parametros_MySQL_Conexao" & vbCr & _
           "Procedimento: " & "MySQL_Server" & vbCr & _
           "Linha: " & Erl, vbExclamation

End Sub

'---------------------------------------------------------------------------------------
'  PROCEDIMENTO: Conexao_Open
'     DESCRIÇÃO: Realiza a conexão com o servidor MySQL
'---------------------------------------------------------------------------------------
Public Function Conexao_Open(csql)

    If sErr = -1 Then    'Habilita tratamento de erro
        On Error GoTo Conexao_Open_Erro
    End If

 Call MySQL_Server    'Carrega parametros do servidor
     If cn.State = 1 Then    'verificar o status do banco de dados. Se aberto fecha a conexão
        cn.Close
    End If

     If rs.State = 1 Then    'verificar o status do recordeset. Se aberto fecha a conexão
     rs.Close
    End If

           Select Case Source
           
             Case "PostgreSQL"
        ' Call MySQL_Server    'Carrega parametros do servidor
        cn.Open "Driver={PostgreSQL ANSI};Server=" & MyslqServidor & ";Database=" & MyslqDatabase & ";User=" & MyslqUsuario & "; Password=" & MyslqSenha & "; Port=" & MyslqPorta & ";XaOpt=1;"
        rs.CursorLocation = adUseClient
        rs.Open csql, cn, adOpenDynamic, adLockOptimistic
       
             Case "MySQL"
         'Call MySQL_Server    'Carrega parametros do servidor
         cn.Open "Driver={MySQL ODBC 5.5.25a Driver};Server=" & MyslqServidor & ";Database=" & MyslqDatabase & ";User=" & MyslqUsuario & "; Password=" & MyslqSenha & "; Port=" & MyslqPorta & ";Option=3;"
        rs.CursorLocation = adUseClient
        rs.Open csql, cn, adOpenDynamic, adLockOptimistic
       
           
             Case "Access"
            cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & location
               
         
        Case "SQLite"
          'Call MySQL_Server    'Carrega parametros do servidor
         cn.Open "Driver={SQLite3 ODBC Driver};Server=" & MyslqServidor & ";Database=" & MyslqDatabase & ";User=" & MyslqUsuario & "; Password=" & MyslqSenha & "; Port=" & MyslqPorta
         rs.CursorLocation = adUseClient
         rs.Open csql, cn, adOpenDynamic, adLockOptimistic
     
On Error GoTo 0
Exit Function

Conexao_Open_Erro:

 DoCmd.Hourglass False
    MsgBox "Ocorreu um erro na aplicação." & vbCr & "Relate os dados abaixo ao suporte." & vbCr & _
           "Erro Nº: " & Err.Number & vbCr & _
           "Descrição do erro: " & Err.Description & vbCr & _
           "Módulo: " & "Parametros_MySQL_Conexao" & vbCr & _
           "Procedimento: " & "Conexao_Open" & vbCr & _
           "Linha: " & Erl, vbExclamation
       
End Select


End Function

Avatar do usuário
ahteixeira
Mensagens: 38
Registrado em: 07 Jun 2015, 18:51
Localização: Porto - Portugal

Re: importação de registros

Mensagempor ahteixeira » 08 Jun 2015, 20:35

Olá, veja se este artigo ajuda:
http://www.usandoaccess.com.br/tutoriai ... 1.asp?id=1
Na minha opinião se conseguir vincular o Access à sua base de dados MySql, apenas terá que efectuar no Access uma consulta (à MySql) a criar Tabela (local no Access).
Abraço

wesley
Mensagens: 18
Registrado em: 07 Jun 2015, 02:44

Re: importação de registros

Mensagempor wesley » 08 Jun 2015, 20:45

olá avelino, esse codigo eu coloco em que parte da aplicação?

Disable adblock

Precisamos do seu apoio. Faca uma doacao para o site atraves do Paypal.


Avelino Joao
Mensagens: 7
Registrado em: 07 Jun 2015, 13:30

Re: importação de registros

Mensagempor Avelino Joao » 08 Jun 2015, 21:09

Cria um módulo e troca os campo da tabela no codigo. Para chamar a função, usa dessa forma:

call importar_Produto

Disable adblock

Precisamos do seu apoio. Faca uma doacao para o site atraves do Paypal.



Voltar para “Tabelas”

Quem está online

Usuários neste fórum: Nenhum usuário registrado e 1 visitante