Oi Pessoal! Eu desenvolvi um sistema bem complexo em access e inclusive já implementei o sistema aqui na empresa onde trabalho. O problema é que ao executar algumas rotinas a partir de um botão de formulário, o meu sistema em access fecha sozinho! Apesar de eu já ter identificado a linha de comando em que esse erro ocorre e ter feito varios testes eu não encontrei erro no código e também não entendo o porque dessa maluquice! Se eu não solucionar esse problema meu projeto inteiro vai pro espaço! Eu inclusive já criei um novo arquivo access, importei todos os objetos e tive o trabalho de atribuir as permissões de acesso a todos os objetos novamente, mas não sei porque raios depois de alguns dias de uso este problema volta a aparecer.
Enfim, A rotina onde ocorre o erro é enorme e estou colocando ela prara vocês no final do post. Trata-se de uma rotina com a funcionalidade de extornar um lançamento contabil efetuado no caixa através do fluxo de caixa. Mas o erro ocorre numa linha de código no final da rotina (Me.Requery, que está logo abaixo do comentário 'Ultimos procedimentos')
Alguém pode me ajudar e dizer porque o access está fechando sozinho e como solucionar este problema?
Obrigado!
Private Sub cmdExtornarMov_Click()
On Error GoTo trataerro
Dim rs As DAO.Recordset
Dim DataRetroativa As Boolean 'Utilizada para determinar se o usuário está tentando extornar um lançamento que não seja o ultimo que foi realizado
Dim stMsgDeAlerta As String 'String usada no texto da caixa de mensagem
Dim ExtornoDeInicializacao As Boolean 'Utilizada para 'avisar' que a inicialização do caixa está sendo extornada
'Verifica se é extorno com data retroativa ou se o usuário está tentando extornar a inicialização do caixa
Set rs = CurrentDb.QueryDefs("conCaixa").OpenRecordset
rs.MoveLast
If Me.Dia_Mov <= VBA.Date - 7 Then
MsgBox "Por motivos de segurança, não é permitido extornar um movimento lançado há mais de 7 dias.", vbExclamation, "Atenção"
Exit Sub
ElseIf Me.Referente_a = "Inicialização do Caixa" Then
stMsgDeAlerta = "Você tem certeza de que deseja extornar o lançamento de inicialização do caixa? Este procedimento irá reinicializar o caixa, apagando todos os registros de lançamentos efetuados até o momento."
ExtornoDeInicializacao = True
ElseIf (Me.Dia_Mov < rs!Dia_Mov) Or (Me.Dia_Mov = rs!Dia_Mov And Me.Hora_Mov < rs!Hora_Mov) Then
stMsgDeAlerta = "Você está prestes a extornar um lançamento que não foi o último a ser efetuado. Todos os lançamentos efetuados com data após " & Me.Dia_Mov & " - " & Me.Hora_Mov & " serão reajustados. Tem certeza de que deseja extornar este lançamento?"
DataRetroativa = True
Else
stMsgDeAlerta = "Tem certeza de que deseja extornar o último lançamento efetuado?"
End If
'*****************************************************************
If MsgBox(stMsgDeAlerta _
& vbCrLf & vbCrLf & "Valor: " & Format(Me.Valor_Mov, "Currency") & vbCrLf & "Referente a: " & Me.Referente_a _
& vbCrLf & "Tipo Movimento: " & Me.Tipo_Mov & vbCrLf & "Recebido de/Pago a: " & Me.Nome_Indiv_Empresa _
& vbCrLf & "Descrição: " & Me.Descricao, vbYesNo + vbQuestion, "Atenção!") = vbYes Then
Dim MotivoExtorno As String
If Not ExtornoDeInicializacao = True Then
MotivoExtorno = InputBox("Qual o motivo do extorno? (Opcional - Máximo 100 caracteres)", "Extornar Movimentação")
End If
'Extorna movimento na tabela Caixa_DetalhesDiarios_Referentea
Set rs = CurrentDb.QueryDefs("conCaixa_DetalhesDiarios_Referentea").OpenRecordset
If ExtornoDeInicializacao = True Then
'Apaga todos os registros da tabela Caixa_DetalhesDiarios_Referentea
rs.MoveFirst
Do While Not rs.EOF
rs.Delete
rs.MoveNext
Loop
rs.Requery
'***********************************************************************
Else
rs.FindFirst "DIA =#" & Format(Me.Dia_Mov, "mm/dd/yyyy") & "# AND Referente_a LIKE '" & Me.Referente_a & "'"
rs.Edit
If Me.Tipo_Mov = "Saída" Then
rs!Total_Saidas = rs!Total_Saidas - Me.Valor_Mov
ElseIf Me.Tipo_Mov = "Entrada" Then
rs!Total_Entradas = rs!Total_Entradas - Me.Valor_Mov
End If
rs.Update
End If
'************************************************************
'Extorna movimento na tabela Caixa_DetalhesDiarios
Set rs = CurrentDb.QueryDefs("conCaixa_DetalhesDiarios").OpenRecordset
If ExtornoDeInicializacao = True Then
'Apaga todos os registros da tabela Caixa_DetalhesDiarios
rs.MoveFirst
Do While Not rs.EOF
rs.Delete
rs.MoveNext
Loop
rs.Requery
'***********************************************************************
Else
rs.FindFirst "DIA =#" & Format(Me.Dia_Mov, "mm/dd/yyyy") & "#"
rs.Edit
If Me.Tipo_Mov = "Saída" Then
rs!Total_Saidas = rs!Total_Saidas - Me.Valor_Mov
rs!Saldo_Final = rs!Saldo_Final + Me.Valor_Mov
ElseIf Me.Tipo_Mov = "Entrada" Then
rs!Total_Entradas = rs!Total_Entradas - Me.Valor_Mov
rs!Saldo_Final = rs!Saldo_Final - Me.Valor_Mov
End If
rs.Update
'Se for data retroativa, ajusta os campos Saldo_Inicial e Saldo_Final de todos os registros de lançamento posteriores
If DataRetroativa = True Then
rs.FindFirst "DIA =#" & Format(Me.Dia_Mov, "mm/dd/yyyy") & "#"
rs.MoveNext
Do While Not rs.EOF
rs.Edit
If Me.Tipo_Mov = "Saída" Then
rs!Saldo_Inicial = rs!Saldo_Inicial + Me.Valor_Mov
rs!Saldo_Final = rs!Saldo_Final + Me.Valor_Mov
ElseIf Me.Tipo_Mov = "Entrada" Then
rs!Saldo_Inicial = rs!Saldo_Inicial - Me.Valor_Mov
rs!Saldo_Final = rs!Saldo_Final - Me.Valor_Mov
End If
rs.Update
rs.MoveNext
Loop
End If
'*******************************************************************************
End If
'**********************************************************************
'Cria um registro na tabela Extornos para o extorno realizado se não for extorno de inicialização do caixa,
'ou exclui todos os registros da tabela Extornos se for extorno de inicialização do caixa
Set rs = CurrentDb.TableDefs("Extornos").OpenRecordset
If ExtornoDeInicializacao = True Then
If rs.RecordCount > 0 Then
rs.MoveFirst
Do While Not rs.EOF
rs.Delete
rs.MoveNext
Loop
rs.Requery
End If
Else
rs.AddNew
rs!Efetuado_Por = Me.Efetuado_Por
rs!Dia_Mov = Me.Dia_Mov
rs!Valor_Mov = Me.Valor_Mov
rs!Tipo_Mov = Me.Tipo_Mov
rs!Referente_a = Me.Referente_a
rs!Descricao = Me.Descricao
rs!Dia_Extorno = VBA.Date
rs!Hora_Extorno = VBA.Time
rs!Extornado_Por = CurrentUser
rs!Motivo = MotivoExtorno
rs.Update
End If
'*********************************************************************
'Extorna o movimento na tabela Caixa
Set rs = CurrentDb.QueryDefs("conCaixa").OpenRecordset
If ExtornoDeInicializacao = True Then
rs.MoveFirst
Do While Not rs.EOF
rs.Delete
rs.MoveNext
Loop
rs.Requery
Else
'Reajusta os registros de lançamentos posteriores
If DataRetroativa = True Then
rs.FindFirst "Cod_Mov =" & Me.Cod_Mov
rs.MoveNext
Do While Not rs.EOF
rs.Edit
If Me.Tipo_Mov = "Saída" Then
rs!Saldo_Atual = rs!Saldo_Atual + Me.Valor_Mov
'rs!Saldo_Final = rs!Saldo_Final + Me.Valor_Mov
ElseIf Me.Tipo_Mov = "Entrada" Then
rs!Saldo_Atual = rs!Saldo_Atual - Me.Valor_Mov
'rs!Saldo_Final = rs!Saldo_Final - Me.Valor_Mov
End If
rs.Update
rs.MoveNext
Loop
End If
'***********************************************************
'Exclui o lançamento que está sendo extornado
rs.FindFirst "Cod_Mov =" & Me.Cod_Mov
rs.Delete
'************************************************************
End If
'**********************************************************************************
MsgBox "Extorno realizado com sucesso.", vbExclamation, "Sucesso"
'Ultimos procedimentos
Me.RecordSource = "SELECT Caixa.* FROM Caixa ORDER BY [Caixa].[Dia_Mov] DESC , [Caixa].[Hora_Mov] DESC , [Caixa].[Cod_Mov] DESC; "
Me.Requery
Set rs = Me.RecordsetClone
If rs.RecordCount = 0 Then
MsgBox "Não há registros de movimentação no caixa. O Formulário será fechado", vbExclamation, "Atenção"
DoCmd.Close
Else
'Ajusta o valor da lblSaldoCaixa, que exibe o saldo atual do caixa
lblSaldoCaixa.Caption = Format(Me.Saldo_Atual, "Currency")
'******************************************************************
End If
Set rs = Nothing
'**********************************************************
End If
Exit Sub
trataerro:
MsgBox Err & ": " & Err.Description
End Sub
Pergunta
brunohjoia
Oi Pessoal! Eu desenvolvi um sistema bem complexo em access e inclusive já implementei o sistema aqui na empresa onde trabalho. O problema é que ao executar algumas rotinas a partir de um botão de formulário, o meu sistema em access fecha sozinho! Apesar de eu já ter identificado a linha de comando em que esse erro ocorre e ter feito varios testes eu não encontrei erro no código e também não entendo o porque dessa maluquice! Se eu não solucionar esse problema meu projeto inteiro vai pro espaço! Eu inclusive já criei um novo arquivo access, importei todos os objetos e tive o trabalho de atribuir as permissões de acesso a todos os objetos novamente, mas não sei porque raios depois de alguns dias de uso este problema volta a aparecer.
Enfim, A rotina onde ocorre o erro é enorme e estou colocando ela prara vocês no final do post. Trata-se de uma rotina com a funcionalidade de extornar um lançamento contabil efetuado no caixa através do fluxo de caixa. Mas o erro ocorre numa linha de código no final da rotina (Me.Requery, que está logo abaixo do comentário 'Ultimos procedimentos')
Alguém pode me ajudar e dizer porque o access está fechando sozinho e como solucionar este problema?
Obrigado!
Private Sub cmdExtornarMov_Click() On Error GoTo trataerro Dim rs As DAO.Recordset Dim DataRetroativa As Boolean 'Utilizada para determinar se o usuário está tentando extornar um lançamento que não seja o ultimo que foi realizado Dim stMsgDeAlerta As String 'String usada no texto da caixa de mensagem Dim ExtornoDeInicializacao As Boolean 'Utilizada para 'avisar' que a inicialização do caixa está sendo extornada 'Verifica se é extorno com data retroativa ou se o usuário está tentando extornar a inicialização do caixa Set rs = CurrentDb.QueryDefs("conCaixa").OpenRecordset rs.MoveLast If Me.Dia_Mov <= VBA.Date - 7 Then MsgBox "Por motivos de segurança, não é permitido extornar um movimento lançado há mais de 7 dias.", vbExclamation, "Atenção" Exit Sub ElseIf Me.Referente_a = "Inicialização do Caixa" Then stMsgDeAlerta = "Você tem certeza de que deseja extornar o lançamento de inicialização do caixa? Este procedimento irá reinicializar o caixa, apagando todos os registros de lançamentos efetuados até o momento." ExtornoDeInicializacao = True ElseIf (Me.Dia_Mov < rs!Dia_Mov) Or (Me.Dia_Mov = rs!Dia_Mov And Me.Hora_Mov < rs!Hora_Mov) Then stMsgDeAlerta = "Você está prestes a extornar um lançamento que não foi o último a ser efetuado. Todos os lançamentos efetuados com data após " & Me.Dia_Mov & " - " & Me.Hora_Mov & " serão reajustados. Tem certeza de que deseja extornar este lançamento?" DataRetroativa = True Else stMsgDeAlerta = "Tem certeza de que deseja extornar o último lançamento efetuado?" End If '***************************************************************** If MsgBox(stMsgDeAlerta _ & vbCrLf & vbCrLf & "Valor: " & Format(Me.Valor_Mov, "Currency") & vbCrLf & "Referente a: " & Me.Referente_a _ & vbCrLf & "Tipo Movimento: " & Me.Tipo_Mov & vbCrLf & "Recebido de/Pago a: " & Me.Nome_Indiv_Empresa _ & vbCrLf & "Descrição: " & Me.Descricao, vbYesNo + vbQuestion, "Atenção!") = vbYes Then Dim MotivoExtorno As String If Not ExtornoDeInicializacao = True Then MotivoExtorno = InputBox("Qual o motivo do extorno? (Opcional - Máximo 100 caracteres)", "Extornar Movimentação") End If 'Extorna movimento na tabela Caixa_DetalhesDiarios_Referentea Set rs = CurrentDb.QueryDefs("conCaixa_DetalhesDiarios_Referentea").OpenRecordset If ExtornoDeInicializacao = True Then 'Apaga todos os registros da tabela Caixa_DetalhesDiarios_Referentea rs.MoveFirst Do While Not rs.EOF rs.Delete rs.MoveNext Loop rs.Requery '*********************************************************************** Else rs.FindFirst "DIA =#" & Format(Me.Dia_Mov, "mm/dd/yyyy") & "# AND Referente_a LIKE '" & Me.Referente_a & "'" rs.Edit If Me.Tipo_Mov = "Saída" Then rs!Total_Saidas = rs!Total_Saidas - Me.Valor_Mov ElseIf Me.Tipo_Mov = "Entrada" Then rs!Total_Entradas = rs!Total_Entradas - Me.Valor_Mov End If rs.Update End If '************************************************************ 'Extorna movimento na tabela Caixa_DetalhesDiarios Set rs = CurrentDb.QueryDefs("conCaixa_DetalhesDiarios").OpenRecordset If ExtornoDeInicializacao = True Then 'Apaga todos os registros da tabela Caixa_DetalhesDiarios rs.MoveFirst Do While Not rs.EOF rs.Delete rs.MoveNext Loop rs.Requery '*********************************************************************** Else rs.FindFirst "DIA =#" & Format(Me.Dia_Mov, "mm/dd/yyyy") & "#" rs.Edit If Me.Tipo_Mov = "Saída" Then rs!Total_Saidas = rs!Total_Saidas - Me.Valor_Mov rs!Saldo_Final = rs!Saldo_Final + Me.Valor_Mov ElseIf Me.Tipo_Mov = "Entrada" Then rs!Total_Entradas = rs!Total_Entradas - Me.Valor_Mov rs!Saldo_Final = rs!Saldo_Final - Me.Valor_Mov End If rs.Update 'Se for data retroativa, ajusta os campos Saldo_Inicial e Saldo_Final de todos os registros de lançamento posteriores If DataRetroativa = True Then rs.FindFirst "DIA =#" & Format(Me.Dia_Mov, "mm/dd/yyyy") & "#" rs.MoveNext Do While Not rs.EOF rs.Edit If Me.Tipo_Mov = "Saída" Then rs!Saldo_Inicial = rs!Saldo_Inicial + Me.Valor_Mov rs!Saldo_Final = rs!Saldo_Final + Me.Valor_Mov ElseIf Me.Tipo_Mov = "Entrada" Then rs!Saldo_Inicial = rs!Saldo_Inicial - Me.Valor_Mov rs!Saldo_Final = rs!Saldo_Final - Me.Valor_Mov End If rs.Update rs.MoveNext Loop End If '******************************************************************************* End If '********************************************************************** 'Cria um registro na tabela Extornos para o extorno realizado se não for extorno de inicialização do caixa, 'ou exclui todos os registros da tabela Extornos se for extorno de inicialização do caixa Set rs = CurrentDb.TableDefs("Extornos").OpenRecordset If ExtornoDeInicializacao = True Then If rs.RecordCount > 0 Then rs.MoveFirst Do While Not rs.EOF rs.Delete rs.MoveNext Loop rs.Requery End If Else rs.AddNew rs!Efetuado_Por = Me.Efetuado_Por rs!Dia_Mov = Me.Dia_Mov rs!Valor_Mov = Me.Valor_Mov rs!Tipo_Mov = Me.Tipo_Mov rs!Referente_a = Me.Referente_a rs!Descricao = Me.Descricao rs!Dia_Extorno = VBA.Date rs!Hora_Extorno = VBA.Time rs!Extornado_Por = CurrentUser rs!Motivo = MotivoExtorno rs.Update End If '********************************************************************* 'Extorna o movimento na tabela Caixa Set rs = CurrentDb.QueryDefs("conCaixa").OpenRecordset If ExtornoDeInicializacao = True Then rs.MoveFirst Do While Not rs.EOF rs.Delete rs.MoveNext Loop rs.Requery Else 'Reajusta os registros de lançamentos posteriores If DataRetroativa = True Then rs.FindFirst "Cod_Mov =" & Me.Cod_Mov rs.MoveNext Do While Not rs.EOF rs.Edit If Me.Tipo_Mov = "Saída" Then rs!Saldo_Atual = rs!Saldo_Atual + Me.Valor_Mov 'rs!Saldo_Final = rs!Saldo_Final + Me.Valor_Mov ElseIf Me.Tipo_Mov = "Entrada" Then rs!Saldo_Atual = rs!Saldo_Atual - Me.Valor_Mov 'rs!Saldo_Final = rs!Saldo_Final - Me.Valor_Mov End If rs.Update rs.MoveNext Loop End If '*********************************************************** 'Exclui o lançamento que está sendo extornado rs.FindFirst "Cod_Mov =" & Me.Cod_Mov rs.Delete '************************************************************ End If '********************************************************************************** MsgBox "Extorno realizado com sucesso.", vbExclamation, "Sucesso" 'Ultimos procedimentos Me.RecordSource = "SELECT Caixa.* FROM Caixa ORDER BY [Caixa].[Dia_Mov] DESC , [Caixa].[Hora_Mov] DESC , [Caixa].[Cod_Mov] DESC; " Me.Requery Set rs = Me.RecordsetClone If rs.RecordCount = 0 Then MsgBox "Não há registros de movimentação no caixa. O Formulário será fechado", vbExclamation, "Atenção" DoCmd.Close Else 'Ajusta o valor da lblSaldoCaixa, que exibe o saldo atual do caixa lblSaldoCaixa.Caption = Format(Me.Saldo_Atual, "Currency") '****************************************************************** End If Set rs = Nothing '********************************************************** End If Exit Sub trataerro: MsgBox Err & ": " & Err.Description End SubLink para o comentário
Compartilhar em outros sites
4 respostass a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.