MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

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


+2
vieirasoft
maguim
6 participantes

    [Resolvido]back End corrompendo diversas vezes no dia

    maguim
    maguim
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 449
    Registrado : 15/05/2013

    [Resolvido]back End corrompendo diversas vezes no dia Empty [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  maguim 29/11/2018, 14:52

    Boa tarde meu amigos tudo bem ?

    Ando enfrentando alguns problemas de corrupção de front.

    Eu ja nao sei mais o que fazer. Preciso de mais alternativas pra explorar aonde corrompe.


    Meu front é usado por 6 pessoas;
    Meu back é do proprio access;
    Rede local;
    Tem alguns consultas de atualização;
    Algumas partes de inserção no back end;
    Todas as inserções em DAO;
    Ja tentei colocar modulo do JP pra tentar evitar corrupção. (Esta dando erro de looping);
    Ja separei o front pra cada usuario usar, ou seja, cada um tem proprio front. Mesmo assim nao adiantou;
    Front totalmente sem associação de campos em txt.



    Erros:
    aparecem do nada, nem a msg do access mostrando numero de errp aparece é corrompido direto;
    Ja premiditei todos erros possiveis em VBA;


    Codigos:
    Ja limpei meu front com vbas não utilizáveis;
    Codigos simples sem loopings, somente de inserção e atualização e consultas;
    Vbas de compactação e reparos pos fechar o banco.

    Rede:
    Rede local muito lenta durante algumas vezes do dia;
    Pasta de rede com controle total pra todos;

    Erros
    ja apareceu erro de ID
    Formato nao reconhecido.


    Ja não sei mais o que fazer. Alguem pra me dar uma luz? Crying or Very sad

    Abraços


    Última edição por maguim em 7/12/2018, 01:08, editado 1 vez(es)


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    vieirasoft
    vieirasoft
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7304
    Registrado : 11/05/2010

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  vieirasoft 29/11/2018, 16:18

    Uma sugestão:Já tentou criar uma nova BD e copiar todos os itens? Por vezes resolve.
    Silvio
    Silvio
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 5120
    Registrado : 20/04/2011

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  Silvio 29/11/2018, 16:19

    Erros
    ja apareceu erro de ID
    Formato nao reconhecido.


    Causa mais provável.....ID está em formato errado ( de numero colocou texto ou vice versa... em alguma rotina de exportação ou acréscimo )

    Rede:
    Rede local muito lenta durante algumas vezes do dia;
    Pasta de rede com controle total pra todos;

    Rede lenta...causa mais provável....servidor mal dimensionado para o trabalho ou alguma rotina pesada nele sendo executada ao longo do dia ( antivirus pode ser uma delas ).


    .................................................................................
    Caso tenha resolvido a tua duvida, coloque o tópico como resolvido.
    www.maximoaccess.com/t860-resolucao-de-topicos

    "Quase tudo é possível quando se tem determinação e força de vontade. Não desista tão rápido."
    Silvio
    Silvio
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 5120
    Registrado : 20/04/2011

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  Silvio 29/11/2018, 16:20

    Opa....Desculpa Sérgio, não vi que estavas a responder !!


    .................................................................................
    Caso tenha resolvido a tua duvida, coloque o tópico como resolvido.
    www.maximoaccess.com/t860-resolucao-de-topicos

    "Quase tudo é possível quando se tem determinação e força de vontade. Não desista tão rápido."
    vieirasoft
    vieirasoft
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7304
    Registrado : 11/05/2010

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  vieirasoft 29/11/2018, 16:27

    Tudo bem, Silvio. Por vezes somos poucos rsrsrs
    maguim
    maguim
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 449
    Registrado : 15/05/2013

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  maguim 29/11/2018, 17:28

    @vieirasoft

    Ja fiz isso algumas vezes. Neutral


    @Silvio

    Cara, a rede eu preciso ver com os caras da rede. Acabei de marcar um reunião sobre o fato.


    uma duvida, muitos recordset estavam sem:

    Código:
    set rs = nothing

    entao ja coloquei em todos

    agora o DB é preciso colocar = nothing tb?


    alguem tem alguma coisa pronta de controle de erros com inserções em tabela...


    ex: deu erro ou alguma corrupção no banco, ele inseri qual erro que deu e aonde foi. TIPO LOG


    abraços


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    Silvio
    Silvio
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 5120
    Registrado : 20/04/2011

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  Silvio 30/11/2018, 10:15

    Bom dia.....

    Coloque sim....é bom e muito útil ao SGDB

         Set RS = Nothing
         Set DB = Nothing
         Set RS = Close
         Set DB = Close


    .................................................................................
    Caso tenha resolvido a tua duvida, coloque o tópico como resolvido.
    www.maximoaccess.com/t860-resolucao-de-topicos

    "Quase tudo é possível quando se tem determinação e força de vontade. Não desista tão rápido."
    Alexandre Fim
    Alexandre Fim
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3491
    Registrado : 13/12/2016

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  Alexandre Fim 30/11/2018, 10:36

    Bom dia Maguim,

    Você esta utilizando algum componente (.ocx) que não seja nativo do Access?

    É muito comum o Access gerar instabilidade por componentes que não são nativos do Office, apesar de serem nativos do Windows (MSCOMCTL.ocx- Listview, Treeview, Toolbar, StatusBar e etc.), onde você até consegue utilizá-los, mas que pode gerar erro por conta de versões diferentes entre máquinas e de arquiteturas diferentes também (32 e 64 bits).

    Verifique se existe algum módulo com chamadas de funções ou API's que não esteja utilizando.
    Tenho visto alguns exemplos aqui no fórum de membros mais "novatos" que criam sistemas usando o "CTRL+C e CTRL+V" para "fazer funcionar" seu sistema.
    Alguns objetos e/ou rotinas são desnecessários dentro do sistema.

    Se possível, poste seu banco de dados para os colaboradores do fórum analisar e buscar uma solução.

    Um abraço.
    maguim
    maguim
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 449
    Registrado : 15/05/2013

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  maguim 30/11/2018, 12:08

    @alexandre

    Bom dia amigo !

    tudo bem !

    Entao, certifiquei que em todas as maquina tem office 2016 intalado e todos com keys validadas (nada de crakeado).
    Em Relação do Copia e cola eu montei meu Projeto do 0, acredito que talvez não tenha algo assim de tanto problema na modulagem de codigos, Porem a gente nunca sabe de tudo neh rs... Very Happy

    sobre os componentes não faço ideia teria que pesquisar mais sobre o assunto..

    Eu tambem mandei msg privado pra vc, se puder da uma olhada!

    Eu gostaria de postar meu bd porem por motivos judiciais não poderei.


    @silvio

    Tudo bom meu amigo?

    Entao os meu recordsets tem

    Código:
    rs.close
    db.close
    set rs = nothing
    set db = nothing


    tenho que colocar tb?:

    Código:
    set rs = close
    set db = close

    nao seria mesma coisa que:

    Código:
    rs.close
    db.close


    abraços


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    Alexandre Fim
    Alexandre Fim
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3491
    Registrado : 13/12/2016

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  Alexandre Fim 30/11/2018, 12:44

    Ok Maguim.
    Abraços
    Silvio
    Silvio
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 5120
    Registrado : 20/04/2011

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  Silvio 30/11/2018, 18:56

    Seria bom viu....colocar o set


    .................................................................................
    Caso tenha resolvido a tua duvida, coloque o tópico como resolvido.
    www.maximoaccess.com/t860-resolucao-de-topicos

    "Quase tudo é possível quando se tem determinação e força de vontade. Não desista tão rápido."
    maguim
    maguim
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 449
    Registrado : 15/05/2013

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  maguim 1/12/2018, 21:00

    vou mudar a estrutura do back end, vou fazer de forma desvinculada. assim que fazer todas as alterações dou uma posição pra ver se realmente melhorou.


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    maguim
    maguim
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 449
    Registrado : 15/05/2013

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  maguim 6/12/2018, 15:24

    bom dia meu amigos!!!


    tudo bem?

    Entao fiz algumas alterações na parte de modulagem do codigo e percebi que parou um pouco de corromper...


    porem notei que esta corrompendo sempre nos horarios das 11 da manha as 13 da tarde! o backend

    o que acham que pode ser?


    será que sobre carga de memoria? acho que nao pode ser... pelo fato que tudo recordset tem:

    close e Nothing setado.



    abraços


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3845
    Registrado : 22/11/2016

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  DamascenoJr. 6/12/2018, 18:52

    Qual o tamanho do seu arquivo back-end? e Front-end? Já melhoraram a qualidade da rede onde o aplicativo roda? Tem muitas quedas de energia por aí? São quantos usuários ativos mesmo? Já que está a utilizar de forma desvinculada, que tal tentar mysql?
    maguim
    maguim
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 449
    Registrado : 15/05/2013

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  maguim 6/12/2018, 19:03

    @ivan


    beleza meu amigo?


    entao jao 6 usuarios apenas. ele esta estruturado pra ter um mysql futuro... no momento estamos acertando as estruturas de dados. pra depois pensar em algo como mysql


    Cara sinceramente, sobre a rede... nao sei se cai energia algo do tipo aqui a empresa tem 500 funcionarios e tem uma equipe que cuida só da rede. entendeu?

    o backend é pequeno ainda... 7 mega somente.


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3845
    Registrado : 22/11/2016

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  DamascenoJr. 6/12/2018, 19:10

    para 6 usuários e um arquivo que por enquanto tem 7 megas não devia acontecer. Devia rodar lisinho. A solução é reavaliar todos os campos de todas as tabelas e os códigos que trabalham os dados nelas contidos. Tem algum "nó" por aí.
    maguim
    maguim
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 449
    Registrado : 15/05/2013

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  maguim 7/12/2018, 01:05

    pois é.... o gozado que tem uma rotina pra corromper sempre das 11 da manha as 13 da tarde. depois nao corrompe mais. estranho nao ?


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3845
    Registrado : 22/11/2016

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  DamascenoJr. 7/12/2018, 02:26

    Tente simular as mesmas condições de uso em outro local. Atente-se também aos engraçadinhos mais espertos que podem estar navegando na pasta do backend no horário de almoço (justo quando o movimento costuma diminuir e as chances de serem pegos é quase nula) querendo prejudicar você.
    maguim
    maguim
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 449
    Registrado : 15/05/2013

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  maguim 7/12/2018, 14:12

    Sera que o servidor que aloca a pasta esta sem service pack 1?


    https://support.microsoft.com/pt-br/help/946205/error-message-when-you-try-to-open-a-compiled-database-file-or-a-compi


    Pq aparece toda vez quando corrompe o backend formato na reconhecido


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3845
    Registrado : 22/11/2016

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  DamascenoJr. 7/12/2018, 14:18

    Todas as estações que acessam o backend estão com a mesma versão do access?
    maguim
    maguim
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 449
    Registrado : 15/05/2013

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  maguim 7/12/2018, 14:51

    @ivan


    Pior que sim, todas estao com access 2007 - 2016.


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    maguim
    maguim
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 449
    Registrado : 15/05/2013

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  maguim 7/12/2018, 15:44

    acho que descobri um novo erro no recordset na parte de atualização talvez seja isso que esteja corrompendo o BE.

    numero do erro 3343... esse erro é o erro de formato nao reconhecido... BE

    eu ate consigo tratar esse erro porem, nao adianta tratar o erro ele sempre existir nao é vdd? preciso saber a causa dele.


    erro foi encontrado aqui Private Sub STATUSPROG_AfterUpdate()


    seue codigo abaixo

    Código:
    Option Compare Database
    Option Explicit
    Private Sub ANDAMENTOFILA_AfterUpdate()
    On Error GoTo tratarErroFila
    If Me.ANDAMENTOFILA = "E-MAIL PROPOSTA CRED" Then
        If MsgBox("Tem Certeza que deseja alterar FILA DE PROCESSO do Prestador", vbYesNo, "Exit") = vbYes Then
        
            Dim rs As DAO.Recordset
            Set rs = CurrentDb.OpenRecordset("select id_geral, FILA_STATUS, DT1, RESPONSAVEL1, FILA1 From FILA where [id_geral] = '" & Forms!formhistorico!CODPASTA & "'")
                rs.Edit
                
                    rs("FILA_STATUS") = Me.ANDAMENTOFILA
                    rs("DT1") = Format(Date, "dd/mm/yyyy")
                    rs("FILA1") = 1
                    rs("RESPONSAVEL1") = getUsuarioAtual()
                rs.Update
                rs.Close
                Set rs = Nothing
                
            
                MsgBox " FILA Registrada"
                

        End If

    End If
    If Me.ANDAMENTOFILA.Text = "PROSPEÇÃO PREST REGIÃO" Then
        If MsgBox("Tem Certeza que deseja alterar FILA DE PROCESSO do Prestador", vbYesNo, "Exit") = vbYes Then
        
            Dim rs2 As DAO.Recordset
            Set rs2 = CurrentDb.OpenRecordset("select id_geral, FILA_STATUS2, DT2, RESPONSAVEL2, FILA2, FILA1 From FILA where [id_geral] = '" & Forms!formhistorico!CODPASTA & "'")
                rs2.Edit
                
                    rs2("FILA_STATUS2") = Me.ANDAMENTOFILA
                    rs2("DT2") = Format(Date, "dd/mm/yyyy")
                    rs2("FILA2") = 1
                    rs2("FILA1") = False
                    rs2("RESPONSAVEL2") = getUsuarioAtual()
                rs2.Update
                rs2.Close
                Set rs2 = Nothing
                
            
                MsgBox " FILA Registrada"
        End If
    End If
    If Me.ANDAMENTOFILA.Text = "DOCUMENTAÇÃO PREST ANALIS" Then
        If MsgBox("Tem Certeza que deseja alterar FILA DE PROCESSO do Prestador", vbYesNo, "Exit") = vbYes Then
        
            Dim rs3 As DAO.Recordset
            Set rs3 = CurrentDb.OpenRecordset("select id_geral, FILA_STATUS3, DT3, RESPONSAVEL3, FILA3, FILA2 From FILA where [id_geral] = '" & Forms!formhistorico!CODPASTA & "'")
                rs3.Edit
                
                    rs3("FILA_STATUS3") = Me.ANDAMENTOFILA
                    rs3("DT3") = Format(Date, "dd/mm/yyyy")
                    rs3("FILA3") = 1
                    rs3("FILA2") = False
                    rs3("RESPONSAVEL3") = getUsuarioAtual()
                rs3.Update
                rs3.Close
                Set rs3 = Nothing
                
            
                MsgBox " FILA Registrada"
        End If
    End If

    If Me.ANDAMENTOFILA.Text = "CONFECÇÃO CONTRATO" Then
        If MsgBox("Tem Certeza que deseja alterar FILA DE PROCESSO do Prestador", vbYesNo, "Exit") = vbYes Then
        
            Dim rs4 As DAO.Recordset
            Set rs4 = CurrentDb.OpenRecordset("select id_geral, FILA_STATUS4, DT4, RESPONSAVEL4, FILA4, FILA3 From FILA where [id_geral] = '" & Forms!formhistorico!CODPASTA & "'")
                rs4.Edit
                
                    rs4("FILA_STATUS4") = Me.ANDAMENTOFILA
                    rs4("DT4") = Format(Date, "dd/mm/yyyy")
                    rs4("FILA4") = 1
                    rs4("FILA3") = False
                    rs4("RESPONSAVEL4") = getUsuarioAtual()
                rs4.Update
                rs4.Close
                Set rs4 = Nothing
                
            
                MsgBox " FILA Registrada"
        End If
    End If
    If Me.ANDAMENTOFILA.Text = "VALIDAÇÃO PRESTADOR" Then
        If MsgBox("Tem Certeza que deseja alterar FILA DE PROCESSO do Prestador", vbYesNo, "Exit") = vbYes Then
        
            Dim rs5 As DAO.Recordset
            Set rs5 = CurrentDb.OpenRecordset("select id_geral, FILA_STATUS5, DT5, RESPONSAVEL5, FILA5, FILA4 From FILA where [id_geral] = '" & Forms!formhistorico!CODPASTA & "'")
                rs5.Edit
                
                    rs5("FILA_STATUS5") = Me.ANDAMENTOFILA
                    rs5("DT5") = Format(Date, "dd/mm/yyyy")
                    rs5("FILA5") = 1
                    rs5("FILA4") = False
                    rs5("RESPONSAVEL5") = getUsuarioAtual()
                rs5.Update
                rs5.Close
                Set rs5 = Nothing
                
            
                MsgBox " FILA Registrada"
        End If
    End If
    If Me.ANDAMENTOFILA.Text = "VALIDAÇÃO DIRETORIA" Then
        If MsgBox("Tem Certeza que deseja alterar FILA DE PROCESSO do Prestador", vbYesNo, "Exit") = vbYes Then
        
            Dim rs6 As DAO.Recordset
            Set rs6 = CurrentDb.OpenRecordset("select id_geral, FILA_STATUS6, DT6, RESPONSAVEL6, FILA6, FILA5 From FILA where [id_geral] = '" & Forms!formhistorico!CODPASTA & "'")
                rs6.Edit
                
                    rs6("FILA_STATUS6") = Me.ANDAMENTOFILA
                    rs6("DT6") = Format(Date, "dd/mm/yyyy")
                    rs6("FILA6") = 1
                    rs6("FILA5") = False
                    rs6("RESPONSAVEL6") = getUsuarioAtual()
                rs6.Update
                rs6.Close
                Set rs6 = Nothing
                
            
                MsgBox " FILA Registrada"
        End If
    End If
    If Me.ANDAMENTOFILA.Text = "CORREIO" Then
        If MsgBox("Tem Certeza que deseja alterar FILA DE PROCESSO do Prestador", vbYesNo, "Exit") = vbYes Then
        
            Dim rs7 As DAO.Recordset
            Set rs7 = CurrentDb.OpenRecordset("select id_geral, FILA_STATUS7, DT7, RESPONSAVEL7, FILA7, FILA6 From FILA where [id_geral] = '" & Forms!formhistorico!CODPASTA & "'")
                rs7.Edit
                
                    rs7("FILA_STATUS7") = Me.ANDAMENTOFILA
                    rs7("DT7") = Format(Date, "dd/mm/yyyy")
                    rs7("FILA7") = 1
                    rs7("FILA6") = False
                    rs7("RESPONSAVEL7") = getUsuarioAtual()
                rs7.Update
                rs7.Close
                Set rs7 = Nothing
                
            
                MsgBox " FILA Registrada"
        End If
    End If
    If Me.ANDAMENTOFILA.Text = "RECLAMAÇÃO PRESTADOR" Then
        If MsgBox("Tem Certeza que deseja alterar FILA DE PROCESSO do Prestador", vbYesNo, "Exit") = vbYes Then
        
            Dim rs8 As DAO.Recordset
            Set rs8 = CurrentDb.OpenRecordset("select id_geral, FILA_STATUS8, DT8, RESPONSAVEL8, FILA8 From FILA where [id_geral] = '" & Forms!formhistorico!CODPASTA & "'")
                rs8.Edit
                
                    rs8("FILA_STATUS8") = Me.ANDAMENTOFILA
                    rs8("DT8") = Format(Date, "dd/mm/yyyy")
                    rs8("FILA8") = 1
                    rs8("RESPONSAVEL8") = getUsuarioAtual()
                rs8.Update
                rs8.Close
                Set rs8 = Nothing
                
            
                MsgBox " FILA Registrada"
        End If
    End If
    If Me.ANDAMENTOFILA.Text = "ENC RECLAMAÇ PREST" Then
        If MsgBox("Tem Certeza que deseja alterar FILA DE PROCESSO do Prestador", vbYesNo, "Exit") = vbYes Then
        
            Dim rs9 As DAO.Recordset
            Set rs9 = CurrentDb.OpenRecordset("select id_geral, FILA_STATUS8, DT8, RESPONSAVEL8, FILA8 From FILA where [id_geral] = '" & Forms!formhistorico!CODPASTA & "'")
                rs9.Edit
                
                    rs9("FILA_STATUS8") = Me.ANDAMENTOFILA
                    rs9("DT8") = Format(Date, "dd/mm/yyyy")
                    rs9("FILA8") = False
                    rs9("RESPONSAVEL8") = getUsuarioAtual()
                rs9.Update
                rs9.Close
                Set rs9 = Nothing
                
            
                MsgBox " FILA Registrada"
        End If
    End If
    If Me.ANDAMENTOFILA.Text = "FINANCEIRO" Then
        If MsgBox("Tem Certeza que deseja alterar FILA DE PROCESSO do Prestador", vbYesNo, "Exit") = vbYes Then
        
            Dim rs13 As DAO.Recordset
            Set rs13 = CurrentDb.OpenRecordset("select id_geral, FILA_STATUS9, DT9, RESPONSAVEL9, FILA9 From FILA where [id_geral] = '" & Forms!formhistorico!CODPASTA & "'")
                rs13.Edit
                
                    rs13("FILA_STATUS9") = Me.ANDAMENTOFILA
                    rs13("DT9") = Format(Date, "dd/mm/yyyy")
                    rs13("FILA9") = 1
                    rs13("RESPONSAVEL9") = getUsuarioAtual()
                rs13.Update
                rs13.Close
                Set rs13 = Nothing
                
            
                MsgBox " FILA Registrada"
        End If
    End If
    If Me.ANDAMENTOFILA.Text = "ENC FINANCEIRO" Then
        If MsgBox("Tem Certeza que deseja alterar FILA DE PROCESSO do Prestador", vbYesNo, "Exit") = vbYes Then
        
            Dim rs10 As DAO.Recordset
            Set rs10 = CurrentDb.OpenRecordset("select id_geral, FILA_STATUS9, DT9, RESPONSAVEL9, FILA9 From FILA where [id_geral] = '" & Forms!formhistorico!CODPASTA & "'")
                rs10.Edit
                
                    rs10("FILA_STATUS9") = Me.ANDAMENTOFILA
                    rs10("DT9") = Format(Date, "dd/mm/yyyy")
                    rs10("FILA9") = False
                    rs10("RESPONSAVEL9") = getUsuarioAtual()
                rs10.Update
                rs10.Close
                Set rs10 = Nothing
            
                MsgBox " FILA Registrada"
        End If
    End If
    If Me.ANDAMENTOFILA.Text = "DOCUMENTO VIGENTE" Then
        If MsgBox("Tem Certeza que deseja alterar FILA DE PROCESSO do Prestador", vbYesNo, "Exit") = vbYes Then
        
            Dim rs11 As DAO.Recordset
            Set rs11 = CurrentDb.OpenRecordset("select id_geral, FILA_STATUS10, DT10, RESPONSAVEL10, FILA10 From FILA where [id_geral] = '" & Forms!formhistorico!CODPASTA & "'")
                rs11.Edit
                
                    rs11("FILA_STATUS10") = Me.ANDAMENTOFILA
                    rs11("DT10") = Format(Date, "dd/mm/yyyy")
                    rs11("FILA10") = False
                    rs11("RESPONSAVEL10") = getUsuarioAtual()
                rs11.Update
                rs11.Close
                Set rs11 = Nothing
                
            
                MsgBox " FILA Registrada"
        End If
    End If
    If Me.ANDAMENTOFILA.Text = "ENC DOCUMENTO VIGENTE" Then
        If MsgBox("Tem Certeza que deseja alterar FILA DE PROCESSO do Prestador", vbYesNo, "Exit") = vbYes Then
        
            Dim rs12 As DAO.Recordset
            Set rs12 = CurrentDb.OpenRecordset("select id_geral, FILA_STATUS10, DT10, RESPONSAVEL10, FILA10 From FILA where [id_geral] = '" & Forms!formhistorico!CODPASTA & "'")
                rs12.Edit
                
                    rs12("FILA_STATUS10") = Me.ANDAMENTOFILA
                    rs12("DT10") = Format(Date, "dd/mm/yyyy")
                    rs12("FILA10") = False
                    rs12("RESPONSAVEL10") = getUsuarioAtual()
                rs12.Update
                rs12.Close
                Set rs12 = Nothing
                
            
                MsgBox " FILA Registrada"
        End If
    End If

    tratarErroFila:
    If Err.Number = 3021 Then

    MsgBox "Inconsistência, INSIRA NOVAMENTE NA FILA", vbCritical

    Dim DB00 As Database
    Dim rs00 As DAO.Recordset


    Set DB00 = CurrentDb()
        Set rs00 = DB00.OpenRecordset("Fila") 'Abre a tabela para lançamento dos dados
         rs00.AddNew
        
         'Informações Pessoais
        
        rs00("ID_GERAL") = Forms!formhistorico!CODPASTA
        
        
        rs00.Update
        rs00.Close
        DB00.Close
        Set rs00 = Nothing
        Me.ANDAMENTOFILA.SetFocus
        
        
    End If

    End Sub

    Private Sub btn_alv_vig_Click()
    On Error GoTo TrataErro
    Dim qdf As QueryDef
    Set qdf = DBEngine(0)(0).CreateQueryDef("temp_vig_fichacad", "SELECT id_geral, DT_VS_VIGENCIA from documentos where id_geral = " & Forms!formhistorico!CODPASTA & "")
    DoCmd.OpenForm "frm_vigencia"
    Forms!frm_vigencia!txtvalid = "alv_vig"

    TrataErro:
    If Err.Number = 3012 Then
    CurrentDb.QueryDefs.Delete ("temp_vig_fichacad")
    DoCmd.OpenForm "frm_vigencia"
    End If


    End Sub

    Private Sub btn_atua_Click() ' ATUALIZA CAMPOS VAZIO
    If Me.LIBERTY_CAMPOS = True Then
     Dim rs As DAO.Recordset
            Set rs = CurrentDb.OpenRecordset("select codpasta, Cnpj, DT_ATUALIZAÇÃO, ENDEREÇO, NUMERO, COMPLEM, Cidade, Uf, BAIRRO, CEP, Email, Telefone, DDD From BANCODEDADOSCENTRAL where [CODPASTA] =" & Forms!formhistorico!CODPASTA)
                rs.Edit
                
                  rs("Cnpj") = Me.CNPJ_PRESTADOR
                  rs("ENDEREÇO") = Me.END
                  rs("NUMERO") = Me.NUM
                  rs("COMPLEM") = Me.COMPL
                  rs("Cidade") = Me.CID
                  rs("BAIRRO") = Me.BAIR
                  rs("Uf") = Me.UF
                  rs("CEP") = Me.CEP
                  rs("Email") = Me.emailprest
                  rs("Telefone") = Me.Telefone
                  rs("DDD") = Me.DDD

                  
                    
                    
                    
                    
                    rs("DT_ATUALIZAÇÃO") = Date
                rs.Update
                rs.Close
                Set rs = Nothing
                
            
                MsgBox " Dados Atualizados "
                
            Else
            
            MsgBox "Liberar Campos para Atualização de Dados", vbInformation, "Atenção"
            
    End If
      Forms!frmPesquisa.Form!subfrmPesquisaClientes1.Requery
    End Sub

    Private Sub BTN_PROCED_CONTR_Click()

    DoCmd.OpenForm "frm_Proced_Contratado", acNormal

    End Sub

    Private Sub Form_Load()
    Me.BTN_PROCED_CONTR.Visible = True
    End Sub

    Private Sub LIBERTY_CAMPOS_Click() 'LIBERA CAMPOS FORM HISTORICO pRA ATUALIZAÇÃO

            
    If Me.LIBERTY_CAMPOS = -1 Then
            Me.END.Locked = False
            Me.BAIR.Locked = False
            Me.NUM.Locked = False
            Me.COMPL.Locked = False
            Me.CEP.Locked = False
            Me.CID.Locked = False
            Me.UF.Locked = False
            Me.DDD.Locked = False
            Me.Telefone.Locked = False
            Me.emailprest.Locked = False
            Me.tip.Locked = False
    Else
            Me.END.Locked = True
            Me.BAIR.Locked = True
            Me.NUM.Locked = True
            Me.COMPL.Locked = True
            Me.CEP.Locked = True
            Me.CID.Locked = True
            Me.UF.Locked = True
            Me.DDD.Locked = True
            Me.Telefone.Locked = True
            Me.emailprest.Locked = True
            Me.tip.Locked = True
    End If
            
    End Sub
    Private Sub btn_avFun_Click()
    Dim qdf As QueryDef
    On Error GoTo TrataErro

    Set qdf = DBEngine(0)(0).CreateQueryDef("temp_vig_fichacad", "SELECT id_geral, DT_FUNC_VIGENCIA from documentos where id_geral = " & Forms!formhistorico!CODPASTA & "")
    DoCmd.OpenForm "frm_vigencia"
    Forms!frm_vigencia!txtvalid = "avFun"
    TrataErro:
    If Err.Number = 3012 Then
    CurrentDb.QueryDefs.Delete ("temp_vig_fichacad")
    DoCmd.OpenForm "frm_vigencia"
    End If


    End Sub

    Private Sub btn_cert_enf_Click()
    Dim qdf As QueryDef
    On Error GoTo TrataErro

    Set qdf = DBEngine(0)(0).CreateQueryDef("temp_vig_fichacad", "SELECT id_geral, DT_REG_TECENF_VIGENCIA from documentos where id_geral = " & Forms!formhistorico!CODPASTA & "")
    DoCmd.OpenForm "frm_vigencia"
    Forms!frm_vigencia!txtvalid = "cert_enf"
    TrataErro:
    If Err.Number = 3012 Then
    CurrentDb.QueryDefs.Delete ("temp_vig_fichacad")
    DoCmd.OpenForm "frm_vigencia"
    End If

    End Sub

    Private Sub btn_cert_med_Click()
    On Error GoTo TrataErro
    Dim qdf As QueryDef
    Set qdf = DBEngine(0)(0).CreateQueryDef("temp_vig_fichacad", "SELECT id_geral, DT_REG_TECMED_VEGENCIA from documentos where id_geral = " & Forms!formhistorico!CODPASTA & "")
    DoCmd.OpenForm "frm_vigencia"
    Forms!frm_vigencia!txtvalid = "cert_med"
    TrataErro:
    If Err.Number = 3012 Then
    CurrentDb.QueryDefs.Delete ("temp_vig_fichacad")
    DoCmd.OpenForm "frm_vigencia"
    End If

    End Sub

    Private Sub btn_cnes_Click()
    On Error GoTo TrataErro
    Dim qdf As QueryDef
    Set qdf = DBEngine(0)(0).CreateQueryDef("temp_vig_fichacad", "SELECT id_geral, DT_CNES_VIGENCIA from documentos where id_geral = " & Forms!formhistorico!CODPASTA & "")
    DoCmd.OpenForm "frm_vigencia"
    Forms!frm_vigencia!txtvalid = "btn_cnes"
    TrataErro:
    If Err.Number = 3012 Then
    CurrentDb.QueryDefs.Delete ("temp_vig_fichacad")
    DoCmd.OpenForm "frm_vigencia"
    End If

    End Sub

    Private Sub btn_comp_banc_Click()
    On Error GoTo TrataErro
    Dim qdf As QueryDef
    Set qdf = DBEngine(0)(0).CreateQueryDef("temp_vig_fichacad", "SELECT id_geral, DT_COMP_BANC_VIGENCIA from documentos where id_geral = " & Forms!formhistorico!CODPASTA & "")
    DoCmd.OpenForm "frm_vigencia"
    Forms!frm_vigencia!txtvalid = "comp_banc"
    TrataErro:
    If Err.Number = 3012 Then
    CurrentDb.QueryDefs.Delete ("temp_vig_fichacad")
    DoCmd.OpenForm "frm_vigencia"
    End If

    End Sub

    Private Sub btn_contr_soc_Click()
    On Error GoTo TrataErro
    Dim qdf As QueryDef
    Set qdf = DBEngine(0)(0).CreateQueryDef("temp_vig_fichacad", "SELECT id_geral, DT_CONTR_SOC_VIGENCIA from documentos where id_geral = " & Forms!formhistorico!CODPASTA & "")
    DoCmd.OpenForm "frm_vigencia"
    Forms!frm_vigencia!txtvalid = "contr_soc"
    TrataErro:
    If Err.Number = 3012 Then
    CurrentDb.QueryDefs.Delete ("temp_vig_fichacad")
    DoCmd.OpenForm "frm_vigencia"
    End If


    End Sub

    Private Sub btn_fichacad_Click()
    On Error GoTo TrataErro
    Dim qdf As QueryDef
    Set qdf = DBEngine(0)(0).CreateQueryDef("temp_vig_fichacad", "SELECT id_geral, DT_VIGENCIA_FICHA from documentos where id_geral = " & Forms!formhistorico!CODPASTA & "")
    DoCmd.OpenForm "frm_vigencia"
    Forms!frm_vigencia!txtvalid = "fichacad"
    TrataErro:
    If Err.Number = 3012 Then
    CurrentDb.QueryDefs.Delete ("temp_vig_fichacad")
    DoCmd.OpenForm "frm_vigencia"
    End If

    End Sub

    Private Sub Btn_Novartis_Click()
    DoCmd.OpenForm "frm_select_norvatis"
    End Sub


    Private Sub btn_pg_atual_Click()
    DoCmd.OpenForm "PG_PONTUAL", acNormal, "", "", , acNormal
    End Sub

    Private Sub Comando277_Click()
    DoCmd.OpenForm "historico", acNormal, "", "", , acNormal
    End Sub

    Private Sub Comando57_Click()
    DoCmd.Close acForm, "formhistorico", acSave
    'Forms!frmPesquisa.Requery
    End Sub


    Private Sub ControleNovartis_AfterUpdate()
    If IsNull(Me.ControleNovartis) Then
    Me.Btn_Novartis.Enabled = False
    End If
    End Sub



    Private Sub Detalhe_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    Forms!Frm_02_01_01_Principal!lblTempo.Caption = "00:00:00"
    End Sub

    Private Sub LISTPROG_DblClick(Cancel As Integer)
    DoCmd.OpenForm "frm_controle_status"
    Forms!frm_controle_status!ID_GERAL = Forms!formhistorico!LISTPROG

    Forms!frm_controle_status!status = DLookup("STATUS", "PROGRAMAS", "ID_PROGCONTR=" & Forms!formhistorico!LISTPROG)
    Forms!frm_controle_status!motivo = DLookup("motivo", "PROGRAMAS", "ID_PROGCONTR=" & Forms!formhistorico!LISTPROG)
    Forms!frm_controle_status!just = DLookup("JUSTIFICATIVA", "PROGRAMAS", "ID_PROGCONTR=" & Forms!formhistorico!LISTPROG)

    ' forms!formhistorico!codpasta



    End Sub

    Private Sub lstHist_Click()
    DoCmd.OpenForm "FrmHistorico"
          
                Forms!frmHistorico.Historico = DLookup("INFORMAÇÃO", "C_ADM", "ID =" & Me.lstHist)
          
                        
                            
                                  
    End Sub
    Private Sub fichacad_Click()
    DoCmd.OpenForm "frm_vigencia"
    End Sub

    Private Sub sel_alv_vig_san_Click()
    If Me.sel_alv_vig_san = -1 Then
        If MsgBox("Tem Certeza que deseja alterar Documento do Prestador", vbYesNo, "Exit") = vbYes Then

    Dim rs As DAO.Recordset
            Set rs = CurrentDb.OpenRecordset("select id_geral, Alvara_Vigilancia_Sanitaria, DT_VS from DOCUMENTOS where id_geral = " & Forms!formhistorico!CODPASTA & "")
                rs.Edit
                
                    rs("Alvara_Vigilancia_Sanitaria") = Me.sel_alv_vig_san
                    rs("DT_VS") = Format(Date, "dd/mm/yyyy")
                rs.Update
                rs.Close
                Set rs = Nothing
            
                MsgBox " DOC Registrado"
                Me.sel_alv_vig_san.Locked = True
                
    Else
    Forms!formhistorico!sel_alv_vig_san = rs!sel_alv_vig_san
    DoCmd.OpenForm "frm_vigencia"
    End If
    Me.Refresh
    Forms!frmPesquisa.Requery

    End If
    End Sub

    Private Sub sel_av_fun_Click()
    If Me.sel_av_fun = -1 Then
        If MsgBox("Tem Certeza que deseja alterar Documento do Prestador", vbYesNo, "Exit") = vbYes Then

    Dim rs As DAO.Recordset
            Set rs = CurrentDb.OpenRecordset("select id_geral, Alvara_funcionamento, DT_FUNC from DOCUMENTOS where id_geral = " & Forms!formhistorico!CODPASTA & "")
                rs.Edit
                    rs("Alvara_funcionamento") = Me.sel_av_fun
                    rs("DT_FUNC") = Format(Date, "dd/mm/yyyy")
                    rs.Update
                    rs.Close
                    Set rs = Nothing
                      
            
                MsgBox " DOC Registrado"
                Me.sel_av_fun.Locked = True
                
    Else
    Forms!formhistorico!sel_av_fun = rs!sel_av_fun
    End If
    Me.Refresh
    Forms!frmPesquisa.Requery

    End If
    End Sub

    Private Sub sel_cert_tec_enf_Click()
    If Me.sel_cert_tec_enf = -1 Then
        If MsgBox("Tem Certeza que deseja alterar Documento do Prestador", vbYesNo, "Exit") = vbYes Then

    Dim rs As DAO.Recordset
            Set rs = CurrentDb.OpenRecordset("select id_geral, Certificado_Registro_Tecnico_Enfermeira, DT_REG_TECENF from DOCUMENTOS where id_geral = " & Forms!formhistorico!CODPASTA & "")
                rs.Edit
                
                    rs("Certificado_Registro_Tecnico_Enfermeira") = Me.sel_cert_tec_enf
                    rs("DT_REG_TECENF") = Format(Date, "dd/mm/yyyy")
                rs.Update
                rs.Close
                Set rs = Nothing
            
                MsgBox " DOC Registrado"
                Me.sel_cert_tec_enf.Locked = True
                
    Else
    Forms!formhistorico!sel_cert_tec_enf = rs!sel_cert_tec_enf
    End If
    Me.Refresh
    Forms!frmPesquisa.Requery

    End If

    End Sub

    Private Sub sel_cert_tec_med_Click()
    If Me.sel_cert_tec_med = -1 Then
        If MsgBox("Tem Certeza que deseja alterar Documento do Prestador", vbYesNo, "Exit") = vbYes Then

    Dim rs As DAO.Recordset
            Set rs = CurrentDb.OpenRecordset("select id_geral, Certificado_Registro_Tecnico_Medico, DT_REG_TECMED from DOCUMENTOS where id_geral = " & Forms!formhistorico!CODPASTA & "")
                rs.Edit
                
                    rs("Certificado_Registro_Tecnico_Medico") = Me.sel_cert_tec_med
                    rs("DT_REG_TECMED") = Format(Date, "dd/mm/yyyy")
                rs.Update
                rs.Close
                Set rs = Nothing
            
                MsgBox " DOC Registrado"
               Me.sel_cert_tec_med.Locked = True
                
    Else
    Forms!formhistorico!sel_cert_tec_med = rs!sel_cert_tec_med
    End If
    Me.Refresh
    Forms!frmPesquisa.Requery

    End If

    End Sub

    Private Sub sel_cnes_Click()
    If Me.sel_cnes = -1 Then
        If MsgBox("Tem Certeza que deseja alterar Documento do Prestador", vbYesNo, "Exit") = vbYes Then

    Dim rs As DAO.Recordset
            Set rs = CurrentDb.OpenRecordset("select id_geral, CNES, DT_CNES from DOCUMENTOS where id_geral = " & Forms!formhistorico!CODPASTA & "")
                rs.Edit
                
                    rs("CNES") = Me.sel_cnes
                    rs("DT_CNES") = Format(Date, "dd/mm/yyyy")
                rs.Update
                rs.Close
                Set rs = Nothing
            
                MsgBox " DOC Registrado"
                Me.sel_cnes.Locked = True
                
    Else
    Forms!formhistorico!sel_cnes = rs!sel_cnes
    End If
    Me.Refresh
    Forms!frmPesquisa.Requery

    End If
    End Sub

    Private Sub sel_compr_banc_Click()
    If Me.sel_compr_banc = -1 Then
        If MsgBox("Tem Certeza que deseja alterar Documento do Prestador", vbYesNo, "Exit") = vbYes Then

    Dim rs As DAO.Recordset
            Set rs = CurrentDb.OpenRecordset("select id_geral, Comprovante_Bancario, DT_COMP_BANC from DOCUMENTOS where id_geral = " & Forms!formhistorico!CODPASTA & "")
                rs.Edit
                
                    rs("Comprovante_Bancario") = Me.sel_compr_banc
                    rs("DT_COMP_BANC") = Format(Date, "dd/mm/yyyy")
                rs.Update
                rs.Close
                Set rs = Nothing
            
                MsgBox " DOC Registrado"
                Me.sel_compr_banc.Locked = True
                
    Else
    Forms!formhistorico!sel_compr_banc = rs!sel_compr_banc
    End If
    Me.Refresh
    Forms!frmPesquisa.Requery

    End If
    End Sub

    Private Sub sel_contr_azimut_Click()
    If Me.sel_contr_azimut = -1 Then
        If MsgBox("Tem Certeza que deseja alterar Documento do Prestador", vbYesNo, "Exit") = vbYes Then

    Dim rs As DAO.Recordset
            Set rs = CurrentDb.OpenRecordset("select id_geral, CONTR_AZIMUTMED, DT_AZIMUTMED from DOCUMENTOS where id_geral = " & Forms!formhistorico!CODPASTA & "")
                rs.Edit
                
                    rs("CONTR_AZIMUTMED") = Me.sel_contr_azimut
                    rs("DT_AZIMUTMED") = Format(Date, "dd/mm/yyyy")
                rs.Update
                rs.Close
                Set rs = Nothing
            
                MsgBox " DOC Registrado"
                Me.sel_contr_azimut.Locked = True
                
    Else
    Forms!formhistorico!sel_contr_azimut = rs!sel_contr_azimut
    End If
    Me.Refresh
    Forms!frmPesquisa.Requery

    End If
    End Sub

    Private Sub sel_contr_soc_Click()
    If Me.sel_contr_soc = -1 Then
        If MsgBox("Tem Certeza que deseja alterar Documento do Prestador", vbYesNo, "Exit") = vbYes Then

    Dim rs As DAO.Recordset
            Set rs = CurrentDb.OpenRecordset("select id_geral, Contrato_Social, DT_CONTR_SOC from DOCUMENTOS where id_geral = " & Forms!formhistorico!CODPASTA & "")
                rs.Edit
                
                    rs("Contrato_Social") = Me.sel_contr_soc
                    rs("DT_CONTR_SOC") = Format(Date, "dd/mm/yyyy")
                rs.Update
                rs.Close
                Set rs = Nothing
            
                MsgBox " DOC Registrado"
                Me.sel_contr_soc.Locked = True
                
    Else
    Forms!formhistorico!sel_contr_soc = rs!sel_contr_soc
    End If
    Me.Refresh
    Forms!frmPesquisa.Requery

    End If
    End Sub

    Private Sub sel_fich_cad_Click()
    If Me.sel_fich_cad = -1 Then
        If MsgBox("Tem Certeza que deseja alterar Documento do Prestador", vbYesNo, "Exit") = vbYes Then

    Dim rs As DAO.Recordset
            Set rs = CurrentDb.OpenRecordset("select id_geral, Ficha_cadastral_preenchida, DT_FICHA from DOCUMENTOS where id_geral = " & Forms!formhistorico!CODPASTA & "")
            rs.Edit
            rs("Ficha_cadastral_preenchida") = Me.sel_fich_cad
            rs("DT_FICHA") = Format(Date, "dd/mm/yyyy")
            rs.Update
            rs.Close
            Set rs = Nothing
                
                MsgBox " DOC Registrado"
                Me.sel_fich_cad.Locked = True
                
    Else
    'Me.sel_fich_cad = rs!sel_fich_cad
    End If
    Me.Refresh
    Forms!frmPesquisa.Requery

    End If

    End Sub

    Private Sub SITUAÇÃO_AfterUpdate()
    If Me.SITUAÇÃO.Column(1) = "INATIVO" Then
        If MsgBox("Tem Certeza que deseja Alterar O Tipo do Prestador", vbYesNo, "Exit") = vbYes Then
        
        Dim rs As Recordset
        Set rs = CurrentDb.OpenRecordset("select codpasta, SITUAÇÃO from BANCODEDADOSCENTRAL where codpasta = " & Me.CODPASTA & "")
        rs.Edit
            rs("SITUAÇÃO") = Me.SITUAÇÃO.Column(1)
        rs.Update
        rs.Close
        Set rs = Nothing
        
        Me.SITUAÇÃO.Enabled = False
        Else
        Me.SITUAÇÃO = rs!SITUAÇÃO
        End If
    End If
    Me.Refresh
    Forms!frmPesquisa.Requery
    End Sub

    Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
     If (Shift And acCtrlMask) > 0 And KeyCode = 188 Then
            MsgBox "Combinação de teclas bloqueadas!", vbCritical
            KeyCode = 0
        End If
    End Sub
    Private Sub STATUSPROG_AfterUpdate()
        Dim rs As DAO.Recordset

        If Me.LISTPROG.ItemsSelected.Count > 0 Then

            If MsgBox("Deseja Alterar o Status " & Me.LISTPROG & "?", _
                      vbQuestion + vbYesNo + vbDefaultButton2, "Confirmação") = vbYes Then


                Set rs = CurrentDb.OpenRecordset("select id_geral = programa, STATUS " _
                                               & "from PROGRAMAS where id_geral = " & Forms!formhistorico!CODPASTA & " AND ID_PROGCONTR=" & Me.LISTPROG.Column(0))
                rs.Edit

                rs("STATUS") = Me.STATUSPROG
                rs.Update
                rs.Close
                Set rs = Nothing
                
                
                
      ' CONTROLE DE ATUALIZAÇÃO NOVARTIS PARTE PROGRAMAS NOVARTIS
                
                 ' Set rs1 = CurrentDb.OpenRecordset("select id_geral, programa, STATUS from PROGRAMAS" & _
                 '                                   "where id_geral = " & Forms!formhistorico!CODPASTA & " AND ID_PROGCONTR=" & Me.LISTPROG.Column(0))
                'rs1.Edit

               ' rs1("STATUS") = Me.STATUSPROG
               ' rs1.Update
               ' rs1.Close
               ' Set rs1 = Nothing
                
                
                    

                MsgBox "Cadastrado com sucesso!", vbExclamation
                Me.LISTPROG.Requery
                
                
                
                
                
                
                'CONTROLE DE STATUS E PPR
                Dim DB2 As Database
                Dim rs2 As DAO.Recordset
                Set DB2 = CurrentDb()
                Set rs2 = DB2.OpenRecordset("CONTROLE_STATUS")
                rs2.AddNew
                rs2("ID_GERAL") = Me.CODPASTA
                rs2("STATUS") = Me.STATUSPROG
                rs2("ID_PROGCONTR") = Me.LISTPROG
                rs2("DT_STATUS") = Date
                rs2("RESPONSAVEL") = getUsuarioAtual()
                rs2("COUNT") = 1
                rs2.Update
                rs2.Close
                DB2.Close
                Set rs2 = Nothing

            End If
        Else
            MsgBox "Nenhum Programa Seleccionado!", vbExclamation, "Informação"
        End If



    End Sub



    pensei em um modulo que compacta e repara o BE automaticamente vê que o avelino tem um modulo desse tipo...

    porem a duvida é será que realmente é isso??

    ta dificil estou numa guerra aqui que ta ruim de mais.


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    JPaulo
    JPaulo
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 11026
    Registrado : 04/11/2009

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  JPaulo 7/12/2018, 15:58

    Só olhando para o que acabou de postar, já vejo muitas asneiras ae.

    Você abre um recordset para cada instrução e usa sempre o CurrentDb.

    Depois no final, abre um DAO.Recordset com um DB00 As Database, em vez de DAO.Database


    Uma boa modelagem de dados, requer por exemplo;

    Código:
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim db1 As DAO.Database
    Dim rst1 As DAO.Recordset
    Dim db2 As DAO.Database
    Dim rst2 As DAO.Recordset
    Dim db3 As DAO.Database
    Dim rst4 As DAO.Recordset

    Set db = CurrentDb
    Set rst = db.OpenRecordset("select .....")

    'bla bla
    rst.Close: Set rst = Nothing
    db.Close: Set db = Nothing

    Set db1 = CurrentDb
    Set rst1 = db.OpenRecordset("select .....")

    'bla bla
    rst1.Close: Set rst1 = Nothing
    db1.Close: Set db1 = Nothing

    Set db2 = CurrentDb
    Set rst2 = db2.OpenRecordset("select .....")

    'bla bla
    rst2.Close: Set rst2 = Nothing
    db2.Close: Set db2 = Nothing

    'etc

    Ou até pode usar sempre o mesmo rst e db, porque no final de cada IF você terá de fechar e limpar a memoria.




    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    [Resolvido]back End corrompendo diversas vezes no dia Folder_announce_new Utilize o Sistema de Busca do Fórum...
    [Resolvido]back End corrompendo diversas vezes no dia Folder_announce_new 102 Códigos VBA Gratuitos...
    [Resolvido]back End corrompendo diversas vezes no dia Folder_announce_new Instruções SQL como utilizar...
    maguim
    maguim
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 449
    Registrado : 15/05/2013

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  maguim 7/12/2018, 16:12

    @jp obrigado pelas dicas mestre, irei me atentar ao que propos.


    mas vc acredita que possa ser isso a corrupção do BE.


    abraços


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    JPaulo
    JPaulo
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 11026
    Registrado : 04/11/2009

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  JPaulo 7/12/2018, 16:23

    Não tenho muitas duvidas.

    Nada melhor que você corrigir e dia após dia verificar se volta a acontecer.

    Se voltar a acontecer depois de alterar, cole aqui todos os trechos de código como fez, para se analisar.


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    [Resolvido]back End corrompendo diversas vezes no dia Folder_announce_new Utilize o Sistema de Busca do Fórum...
    [Resolvido]back End corrompendo diversas vezes no dia Folder_announce_new 102 Códigos VBA Gratuitos...
    [Resolvido]back End corrompendo diversas vezes no dia Folder_announce_new Instruções SQL como utilizar...
    maguim
    maguim
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 449
    Registrado : 15/05/2013

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  maguim 7/12/2018, 16:41

    ta bom jp...

    ultima duvida todo recordset eu preciso abrir um database? mesmo sendo atualização?


    tipo esse codigo abaixo:

    Código:
    Private Sub SITUAÇÃO_AfterUpdate()
    Dim rs As Recordset
    If Me.SITUAÇÃO.Column(1) = "INATIVO" Then
        If MsgBox("Tem Certeza que deseja Alterar O Tipo do Prestador", vbYesNo, "Exit") = vbYes Then
        Set rs = CurrentDb.OpenRecordset("select codpasta, SITUAÇÃO from BANCODEDADOSCENTRAL where codpasta = " & Me.CODPASTA & "")
        rs.Edit
            rs("SITUAÇÃO") = Me.SITUAÇÃO.Column(1)
        rs.Update
        rs.Close: Set rs = Nothing
        
        
        Me.SITUAÇÃO.Enabled = False
        Else
        Me.SITUAÇÃO = rs!SITUAÇÃO
        End If
    End If
    Me.Refresh
    Forms!frmPesquisa.Requery
    End Sub

    tenho que por Dim db As DAO.database e db.Close: Set db = Nothing


    abraços


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    JPaulo
    JPaulo
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 11026
    Registrado : 04/11/2009

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  JPaulo 7/12/2018, 16:52

    Se quiser que o seu banco dure uma vida, sim, deve instanciar sempre e fechar.


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    [Resolvido]back End corrompendo diversas vezes no dia Folder_announce_new Utilize o Sistema de Busca do Fórum...
    [Resolvido]back End corrompendo diversas vezes no dia Folder_announce_new 102 Códigos VBA Gratuitos...
    [Resolvido]back End corrompendo diversas vezes no dia Folder_announce_new Instruções SQL como utilizar...
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3845
    Registrado : 22/11/2016

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  DamascenoJr. 18/12/2018, 12:06

    Nathan, e aí? Resolveu seu problema?


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    maguim
    maguim
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 449
    Registrado : 15/05/2013

    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  maguim 16/4/2019, 20:28

    Caro colegas desculpa a demora!! venho encerrar esse topico.

    Como consegui resolver esse problema?

    - Bom, depois de diversas tentativas que me ajudaram aqui no forum foi:

    * todo recordset com SET = NOTHING (isso ajuda a não ter processamentos sem necessidade)
    * limpar códigos inúteis que não tinha nenhum funcionamento (ajuda na hora do FRONT DEPURAR melhor e com Eficiência)
    * variáveis sem declaração ou funcionamento (ajuda na Depuração do front)

    eeee

    O principal!!!!

    Tiver que mudar de rede, pois a antiga estava freezando de mais, e como sabemos se a rede der um delay de 1 segundo o back end em ACCESS fecha automaticamente e faz backup sozinho e isso estava me injuriando de mais.

    Tive que fazer um rede local em um computador ligado 24hrs com todos as permissões de editar remover e popular ETC

    Acho que todos aqueles que tiverem mesmo problema, acredito que esse tópico ira solucionar.


    Gostaria de dar THANKS a todos, pois todos foram essenciais para que Meu App funcionasse corretamente e no meu contrato aqui na empresa tb.


    Obrigado a todos FAMÍLIA MAXIMOACCESS bounce bounce Very Happy Very Happy


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised

    Conteúdo patrocinado


    [Resolvido]back End corrompendo diversas vezes no dia Empty Re: [Resolvido]back End corrompendo diversas vezes no dia

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 8/11/2024, 04:32