MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Atualização automatica de tabelas

    Compartilhe

    anp3anp3
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 11
    Registrado : 02/10/2012

    Atualização automatica de tabelas

    Mensagem  anp3anp3 em Qui 06 Fev 2014, 14:19

    O código que estou postando abaixo faz parte do programa SIPES do Plínio Mabesi
    esse código faz atualizações (alterações) automáticas no BeckEnd, o sistema funciona
    perfeitamente quando não tem senha nas tabelas.

    Como sou iniciante em access gostaria de saber se alguem pode me ajudar a por esse código para funcionar
    com tabelas com senha. pois uso o OPEN do avelino e meu BeckEnd é com senha.

    Desde Já agradeço a colaboração.


    Função Atualizar:
    Option Compare Database
    Option Explicit

    Sub testeAtualizar()

       Call atualizar

    End Sub

    Function atualizar() As Boolean
       
    'Tipos de dados SQL
    'String = VARCHAR(Tamanho)
    'Memo = MEMO
    'Object = IMAGE
    'Integer = SMALLINT
    'Long = INTEGER
    'Single = REAL
    'Double = FLOAT
    'Currency = MONEY
    'Boolean = BIT
    'Date/Time = DATETIME

    'Variáveis=================================================

       Dim objCon As New classeConexao
       Dim objAtlz As New classeConexao
       Dim rstCon As ADODB.Recordset
       Dim strSql As String
       Dim proximoCodigo As Long
       
    'Código====================================================
           
           'Busca do usuário administrador para atualização do novo campo
           
               Dim strUsuarioAdm As String
           
               strSql = "Select usuario From Usuario Where ordem=1"
               Set rstCon = objCon.consultaBanco(strSql)
               
               If rstCon.RecordCount = 1 Then
                   strUsuarioAdm = rstCon("usuario")
               End If
               
               rstCon.Close
           '====================================================
       
       '1ª Atualização de tabelas - 11/05/08
       'Inclusão do campo confirmada na tabela Receita
       Call atualizaTabela("Receita", "confirmada", "I", "BIT")
       '2ª Atualização de tabelas - 13/05/08
       'Inclusão do campo conta na tabela FormaPagamento
       'Inclusão do campo conta na tabela TipoReceita
       Call atualizaTabela("FormaPagamento", "conta", "I", "INTEGER", "Conta", "codConta")
       Call atualizaTabela("TipoReceita", "conta", "I", "INTEGER", "Conta", "codConta")
       '3ª Atualização de tabelas - 26/11/08
       'Inclusão do campo usuario na tabela FormaPagamento
       Call atualizaTabela("FormaPagamento", "usuario", "I", "VARCHAR(20)", "Usuario", "usuario", "'" & strUsuarioAdm & "'")
       '4ª Atualização de tabelas - 18/12/08
       'Inclusão do campo usuario na tabela TipoReceita
       'Modificação do tamanho do campo descrição na tabela Lancamento
       Call atualizaTabela("TipoReceita", "usuario", "I", "VARCHAR(20)", "Usuario", "usuario", "'" & strUsuarioAdm & "'")
       Call atualizaTabela("Lancamento", "descricao", "M", "VARCHAR(30)")
       '5ª Atualização de tabelas - 17/01/09
       'Inclusão do campo grupoDespesa na tabela Despesa
       'Inclusão do campo grupoDespesa na tabela Receita
       Call atualizaTabela("Despesa", "grupoDespesa", "I", "INTEGER")
       Call atualizaTabela("Receita", "grupoReceita", "I", "INTEGER")
       '6ª Atualização de tabelas - 13/01/13
       'Inclusão do campo LOCAL DA FICHA na tabela FICHA DE VENDAS
       'Inclusão do campo NEGATIVADA na tabela FICHA DE VENDAS
       'Inclusão do campo TIPO DE VENDA na tabela FICHA DE VENDAS
       'Inclusão do campo CEP na tabela FICHA DE VENDAS
       'Inclusão do campo CELULAR na tabela FICHA DE VENDAS
       'Inclusão do campo Código na tabela FICHA DE VENDAS
       'Inclusão do campo Código na tabela VALOR COBRADO
       'Call atualizaTabela("FICHA DE VENDAS", "LOCAL DA FICHA", "I", "VARCHAR (50)")
       'Call atualizaTabela("FICHA DE VENDAS", "NEGATIVADA", "I", "VARCHAR (50)")
       'Call atualizaTabela("FICHA DE VENDAS", "TIPO DE VENDA", "I", "VARCHAR (50)")
       'Call atualizaTabela("FICHA DE VENDAS", "CEP", "I", "VARCHAR (50)")
       'Call atualizaTabela("FICHA DE VENDAS", "CELULAR", "I", "VARCHAR (50)")
       'Call atualizaTabela("FICHA DE VENDAS", "Código", "I", "VARCHAR (50)")
       'Call atualizaTabela("VALOR COBRADO", "Código", "I", "VARCHAR (50)")
       
    '========================================================================================
       
       'Inclui as formas de pagamento para os outros usuários e atualiza as referências.
       strSql = "Select Despesa.usuario as nomeUsuario, Despesa.formaPagamento as codigoForma, FormaPagamento.nomeForma as nomeForma " & _
                   "From Despesa Left Join FormaPagamento On Despesa.formaPagamento = FormaPagamento.codForma " & _
                   "Group By Despesa.usuario, Despesa.formaPagamento, FormaPagamento.nomeForma, FormaPagamento.usuario " & _
                   "Having Despesa.usuario <> '" & strUsuarioAdm & "' And FormaPagamento.usuario='" & strUsuarioAdm & "' " & _
                   "Order By Despesa.usuario, Despesa.formaPagamento"
       
       Set rstCon = objCon.consultaBanco(strSql)
       
       If rstCon.RecordCount > 0 Then
       
           Do Until rstCon.EOF
               proximoCodigo = codigoLivre("FormaPagamento", "codForma")
               strSql = "Insert Into FormaPagamento Values(" & _
                       proximoCodigo & ",'" & rstCon("nomeForma") & "',Null,'" & rstCon("nomeUsuario") & "')"
               Call objAtlz.atualizaBanco(strSql)
               strSql = "Update Despesa Set formaPagamento=" & proximoCodigo & _
                           " Where usuario='" & rstCon("nomeUsuario") & "' And " & _
                           "formaPagamento=" & rstCon("codigoForma")
               Call objAtlz.atualizaBanco(strSql)
               rstCon.MoveNext
           Loop
           
       End If
       
       rstCon.Close

    '========================================================================================
       
       'Inclui os tipos de receita para os outros usuários e atualiza as referências.
       strSql = "Select Receita.usuario as nomeUsuario, Receita.tipoReceita as codigoReceita, " & _
                       "TipoReceita.descricao as nomeReceita, TipoReceita.classe as nomeClasse " & _
                   "From Receita Left Join TipoReceita On Receita.tipoReceita = TipoReceita.codTipoReceita " & _
                   "Group By Receita.usuario, Receita.tipoReceita, TipoReceita.descricao, TipoReceita.classe, TipoReceita.usuario " & _
                   "Having Receita.usuario <> '" & strUsuarioAdm & _
                       "' And TipoReceita.usuario='" & strUsuarioAdm & "' " & _
                   "Order By Receita.usuario, Receita.tipoReceita"
       
       Set rstCon = objCon.consultaBanco(strSql)
       
       If rstCon.RecordCount > 0 Then
       
           Do Until rstCon.EOF
               proximoCodigo = codigoLivre("TipoReceita", "codTipoReceita")
               strSql = "Insert Into TipoReceita Values(" & _
                       proximoCodigo & ",'" & rstCon("nomeReceita") & "','" & _
                       rstCon("nomeClasse") & "',Null,'" & rstCon("nomeUsuario") & "')"
               Call objAtlz.atualizaBanco(strSql)
               
               strSql = "Update Receita Set tipoReceita=" & proximoCodigo & _
                           " Where usuario='" & rstCon("nomeUsuario") & "' And " & _
                           "tipoReceita=" & rstCon("codigoReceita")
               
               Call objAtlz.atualizaBanco(strSql)
               rstCon.MoveNext
           Loop
           
       End If
       
       rstCon.Close

    '========================================================================================
       
    End Function

    Function atualizaTabela(argTabela As String, argCampo As String, argAcao As String, Optional argTipo As String, Optional argTabelaEstrangeira As String, Optional argCampoEstrangeiro As String, Optional argValor As String) As Boolean
    On Error GoTo Erro_Corrigir
       
       Dim dbs As Database
       Dim objCon As New classeConexao
       Dim rstCon As ADODB.Recordset
       Dim strSql As String
       
       strSql = "SELECT " & argCampo & " From " & argTabela
       Set rstCon = objCon.consultaBanco(strSql)
       
       rstCon.Close
       
       'Busca o banco de dados para atuallização
       Set dbs = OpenDatabase(BackEndAtual)
       
       If argAcao = "M" Then

           'Modifica o campo na tabela.
           strSql = "ALTER TABLE " & argTabela & " ALTER COLUMN " & argCampo & " " & argTipo & ";"
           dbs.Execute strSql
           dbs.Close
           atualizaTabela = True
       
       End If
       
       If argAcao = "E" Then
           'Exclui o campo na tabela.
           strSql = "ALTER TABLE " & argTabela & " DROP COLUMN " & argCampo & ";"
           dbs.Execute strSql
           dbs.Close
           atualizaTabela = True
       End If
       
       Exit Function

    Campo_nao_existe:
       
       'Busca o banco de dados para atuallização
       Set dbs = OpenDatabase(BackEndAtual)
       
       If argAcao = "I" Then
           
           'Mensagem informando a atualização
           MsgBox "O módulo de << " & UCase(argTabela) & " >> está desatualizado.  " & vbCrLf & vbCrLf & _
                   "O Sistema irá atualizá-lo para prosseguir.", vbExclamation, "Info.ID - Atualização de Módulos"
           
           ' Inclui o campo na tabela.
           strSql = "ALTER TABLE " & argTabela & " ADD COLUMN " & argCampo & " " & argTipo & ";"
           dbs.Execute strSql
           If argTabelaEstrangeira <> "" And argCampoEstrangeiro <> "" Then
               strSql = "ALTER TABLE " & argTabela & " ADD FOREIGN KEY (" & argCampo & ") References " & argTabelaEstrangeira & "(" & argCampoEstrangeiro & ")"
               dbs.Execute strSql
           End If
           
           'Inclui o valor do novo campo para todos os registros, caso informado
           If argValor <> "" Then
               strSql = "UPDATE " & argTabela & " SET " & argCampo & "=" & argValor
               dbs.Execute strSql
           End If
           
           dbs.Close
           atualizaTabela = True
       End If

    Erro_Saida:
       Exit Function

    Erro_Corrigir:
       If err.Number = 91 Then
           Resume Campo_nao_existe
       Else
           MsgBox err.Description & vbCrLf & "O sistema não foi atualizado. Por favor contate o desenvolvedor."
           atualizaTabela = False
           Resume Erro_Saida
       End If
    End Function

    Dilson
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1602
    Registrado : 11/11/2009

    Re: Atualização automatica de tabelas

    Mensagem  Dilson em Dom 09 Fev 2014, 13:31

    Olá,

    Se for usar tabela vinculada se beneficiando da passagem de senha falsa do front ao back não precisará modificar seu código.

    Como está fazendo ?


    .................................................................................
    Atenção:
    => Antes de implementar qualquer dica, faça um backup do seu projeto;
    => Retorne para marcar o Resolvido ou continuar a discussão;
    => Sempre realize pesquisas antes de postar uma pergunta;

    anp3anp3
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 11
    Registrado : 02/10/2012

    Re: Atualização automatica de tabelas

    Mensagem  anp3anp3 em Dom 09 Fev 2014, 15:35

    olha uso tabelas vinculadas sim e front end também
    uso com o open do avelino a função Atualizar () é chamada na macro
    autoexec

    quando não coloco a função no autoexec funciona perfeitamente
    só que não atualiza as tabelas

    mas quando a função está configurada para rodar no autoexec
    ela da um erro dizendo senha inválida.

    veja na imagem abaixo.

    [Você precisa estar registrado e conectado para ver esta imagem.]

    quando uso as tabelas vinculadas sem senha
    as atualizações ocorrem normalmente sem erro.

    preciso muito que esse sistema de atualização de tabelas funcione com senha..





    Ok Assunto resolvido

    para resolver o problema só troquei as linhas

    set dbs = OpenDatabase(BackEndAtual)

    por

    set dbs = OpenDatabase(BackEndAtual, False, False, ";pwd=MinhaSenha")

    Grato...

      Data/hora atual: Qua 07 Dez 2016, 20:15