[Resolvido]back End corrompendo diversas vezes no dia

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?

Abraços

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

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 ).

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

Tudo bem, Silvio. Por vezes somos poucos rsrsrs

@vieirasoft

Ja fiz isso algumas vezes.


@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

Bom dia.....

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

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

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.

@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...

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

Ok Maguim.
Abraços

Seria bom viu....colocar o set

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.

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

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?

@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.

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í.

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

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ê.

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

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

@ivan


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

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.

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.

@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

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.

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

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

Nathan, e aí? Resolveu seu problema?

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