[Resolvido]Impedir de salvar duas vezes o mesmo registro.

Prezados, boa tarde e boa noite !

Preciso que ao pressionar botão salvar o mesmo salve apenas uma vez. Ou seja se apertar novamente o botão salvar o sistema irá avisar o usuário que o mesmo já fora salvo.

Segue abaixo a rotina que eu uso e não está tendo o efeito necessário pois mesmo sem ter salvo antes, ele avisa que já foi salvo.

If DLookup("codped", "tblpedido", "codped =" & Me!Codped) Then -> é aqui que estou encontrando dificuldade.
'
MsgBox ("Pedido já foi salvo..."), vbInformation, Me.Caption
Else
If MsgBox("O Pedido de Nº " & Me.Codped & " foi incluído. Deseja salvar?", vbQuestion + vbYesNo, Me.Caption) = vbYes Then
DoCmd.RunCommand acCmdSaveRecord

Apenas salientando que:

codped é chave primária com autonumeração.
Tblpedido é a tabela.


Grato a todos desde já.

Olá amigo Silvio,
Ao apertar a primeira vez, mude o foco e coloque como disable.
Não compreendo bem porque está a fazer a verificação do pedido.
Abraço

Grande Alvaro....

Veja como é o código por completo.

Código:

Private Sub bt_salvar_Click()
Dim StrSql As String, strSQL1 As String

If DLookup("codped", "tblpedido", "codped =" & Me!Codped) Then
  '
  MsgBox ("Pedido já foi salvo..."), vbInformation, Me.Caption
Else
 If MsgBox("O Pedido de Nº " & Me.Codped & " foi incluído ou alterado. Deseja salvar?", vbQuestion + vbYesNo, Me.Caption) = vbYes Then
      DoCmd.RunCommand acCmdSaveRecord
            ' aqui faço a inserção na tabela pedido o valor total da ordem
      Dim DB As Database, rs As Recordset
      Set DB = CurrentDb()
      Set rs = DB.OpenRecordset("tblpedido", dbOpenDynaset)
      rs.FindFirst "Codped = " & Me!Codped
      rs.Edit
      rs("ValorTotalPed") = Me.ValorTotalPed.Value
      rs("IdVendedorOculta") = Me.IdVendedorOculta
      rs.Update
      rs.Close
      Set rs = Nothing
      Set DB = Nothing
    ' fim da inserção
     
     
     
     
      ' aqui faço a inserção dos valores para a tabela vendasfornece e na tblacertocomissao
 StrSql = "INSERT INTO tblvendasfornece (fornecedor, codped, dataped, cliente, totalpedido) Values ('" & Me.Forneoculta.Value & "','" & Me.Codped.Value & "','" & Me.Dataped.Value & "','" & Me.Cliente.Value & "','" & Me.ValorTotalPed.Value & "')"
 CurrentDb.Execute StrSql
 
 
    'aqui faço a exportação para a tabela de acerto de comissão.
    Dim db1 As Database, rs1 As DAO.Recordset
    Set db1 = CurrentDb
    Set rs1 = db1.OpenRecordset("TblAcertoComissao")
    With rs1
    ' os campos abaixo do formulário tem que ser iguais aos que estão na tabela para realizar a exportação
    .AddNew
    ' campos que estão na tabela = campos do fomulario
    ![Codped] = Me.Codped
    ![Dataped] = Me.Dataped
    ![IdVendedor] = Me.IdVendedorOculta
    ![VendedorOculta] = Me.VendedorOculta
    ![CodCliente] = Me.CodCliente
    ![Cliente] = Me.Cliente
    ![PrazoOculta] = Me.Prazoculta
    ![ValortotalPedido] = Me.ValorTotalPed
    ![Forneoculta] = Me.Forneoculta
    ![NossoPedido] = Me.NossoPedido
    .Update
    End With
    MsgBox "O Pedido Nº " & Me.Codped & vbCrLf & "Do cliente  " & Me.Cliente & vbCrLf & "Salvo com sucesso", vbOKOnly, Me.Caption
             
    Else
        Me.Undo
          DoCmd.CancelEvent
    End If
    End If
   

 
 DoCmd.RunCommand acCmdRefresh

End Sub

Eu tenho que impedir que sejam acrescido valores em outras tabelas.
Pois se o usuário pressionar duas vezes o botão salvar......vai ter duplicidade de valores em outras duas tabelas.

antes do else  coloque EXIT SUB

Private Sub bt_salvar_Click()
Dim StrSql As String, strSQL1 As String

If DLookup("codped", "tblpedido", "codped =" & Me!Codped) Then
'
MsgBox ("Pedido já foi salvo..."), vbInformation, Me.Caption

exit sub
Else
If MsgBox("O Pedido de Nº " & Me.Codped & " foi incluído ou alterado. Deseja salvar?", vbQuestion + vbYesNo, Me.Caption) = vbYes Then
DoCmd.RunCommand acCmdSaveRecord
' aqui faço a inserção na tabela pedido o valor total da ordem
Dim DB As Database, rs As Recordset
Set DB = CurrentDb()
Set rs = DB.OpenRecordset("tblpedido", dbOpenDynaset)
rs.FindFirst "Codped = " & Me!Codped
rs.Edit
rs("ValorTotalPed") = Me.ValorTotalPed.Value
rs("IdVendedorOculta") = Me.IdVendedorOculta
rs.Update
rs.Close
Set rs = Nothing
Set DB = Nothing
' fim da inserção




' aqui faço a inserção dos valores para a tabela vendasfornece e na tblacertocomissao
StrSql = "INSERT INTO tblvendasfornece (fornecedor, codped, dataped, cliente, totalpedido) Values ('" & Me.Forneoculta.Value & "','" & Me.Codped.Value & "','" & Me.Dataped.Value & "','" & Me.Cliente.Value & "','" & Me.ValorTotalPed.Value & "')"
CurrentDb.Execute StrSql


'aqui faço a exportação para a tabela de acerto de comissão.
Dim db1 As Database, rs1 As DAO.Recordset
Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("TblAcertoComissao")
With rs1
' os campos abaixo do formulário tem que ser iguais aos que estão na tabela para realizar a exportação
.AddNew
' campos que estão na tabela = campos do fomulario
![Codped] = Me.Codped
![Dataped] = Me.Dataped
![IdVendedor] = Me.IdVendedorOculta
![VendedorOculta] = Me.VendedorOculta
![CodCliente] = Me.CodCliente
![Cliente] = Me.Cliente
![PrazoOculta] = Me.Prazoculta
![ValortotalPedido] = Me.ValorTotalPed
![Forneoculta] = Me.Forneoculta
![NossoPedido] = Me.NossoPedido
.Update
End With
MsgBox "O Pedido Nº " & Me.Codped & vbCrLf & "Do cliente " & Me.Cliente & vbCrLf & "Salvo com sucesso", vbOKOnly, Me.Caption

Else
Me.Undo
DoCmd.CancelEvent
End If
End If



DoCmd.RunCommand acCmdRefresh

End Sub

erinaldo....já coloquei antes..e nada !

tenta assim:


Cancel = True
Exit Sub

Silvio

Acredito que continua salvando porque é um formulário vinculado a tabela, certo?

Se sim, então faça o seguinte:

Na folha de propriedades do formulário coloque:

Permitir Adições = Não


If DLookup("codped", "tblpedido", "codped =" & Me!Codped) Then

' ==== Para verificar a existência de um registro utilizo : If DCount("*", "tblpedido", "codped =" & Me!Codped) > 0 Then

MsgBox ("Pedido já foi salvo..."), vbInformation, Me.Caption

exit sub ' Agora sim, ele sairá da sub sem salvar

Else

If MsgBox("O Pedido de Nº " & Me.Codped & " foi incluído ou alterado. Deseja salvar?", vbQuestion + vbYesNo,
Me.Caption) = vbYes Then

' Entendo que está somente adicionado registro e não editando, então o alterado está de alegre

Me.AllowAdditions = True  'Liberando o  formulário para salvar



DoCmd.RunCommand acCmdSaveRecord
' aqui faço a inserção na tabela pedido o valor total da ordem
Dim DB As Database, rs As Recordset
Set DB = CurrentDb()
Set rs = DB.OpenRecordset("tblpedido", dbOpenDynaset)
rs.FindFirst "Codped = " & Me!Codped
rs.Edit
rs("ValorTotalPed") = Me.ValorTotalPed.Value
rs("IdVendedorOculta") = Me.IdVendedorOculta
rs.Update
rs.Close
Set rs = Nothing
Set DB = Nothing
' fim da inserção

[ ]'s

Olá a todos, mais um pitaco.

Na minha leitura verifico que está a efectuar:
a) actualização na tabela tblpedido
b) inserção na tabela vendasfornece e na tblacertocomissao

Acho que pretende verificar para não repetir a operação b)

A solução será pesquisar uma das tabelas (ou as duas) e verificar se já tem registo, podendo ficar incluído logo no primeiro IF

If DLookup("codped", "tblpedido", "codped =" & Me!Codped) AND . . . Then

Abraço

Bom dia a todos...

Alvaro é isso mesmo, a opção B.

A tabela TblPedido é vinculada, enquanto as outras duas não o são.

Olá, então mãos à obra, veja se assim dá:

Código:

If DLookup("codped", "tblpedido", "codped =" & Me!Codped) And Me!Codped = Nz(DLookup("codped", "tblvendasfornece", "codped =" & Me!Codped), 0) Then

Abraço

É isso mesmo Alvaro...

Show.

Olá Silvio, que bom que resolveu!
Aproveito para agradecer a colaboração das dicas dos colegas Cadu e Noob.
Abraço a todos

É vero......estou tão enrolado e envolvido com esse projeto que peço desculpas ao erinaldo e ao noob pela minha falha em não agradecer.