[Resolvido]Duplicidade Registros - Usando DCount com vários critérios

Olá,

Criei um formulário que exige confiabilidade de informações, então precisei criar um código que evitasse o cadastro duplicado contendo 3 critérios.
Na primeira tentativa funcionou, mas quando obtive mais registros na minha tabela, o código não analisa mais nenhuma informação da tabela, somente a primeira que fiz o teste.

Ao final coloquei que o registro dessa duplicidade abrisse para usuario analisar.

Alguém tem uma sugestão de um código mais preciso que me ajude?


If DCount("*", "tblRegistrosSS", "DataInicial=#" & TxtData & "# and TagEquip='" & TxtEquip.Column(1) & "' and TPM='" & tlSource.Column(1) & "'") > 0 Then

MsgBox "Registro já lançado..." & "Código Nº" & Código

Cancel = True 'cancela o evento.

Me!TxtEquip.Undo
Me!TxtData.Undo
Me!tlSource.Undo 'desfaz a digitação.

Dim stDocname As String
Dim stLinkCriteria As String

stDocname = "tblRegistrosSS"

stLinkCriteria = Código
DoCmd.OpenForm stDocname, , , stLinkCriteria
End If

Olá Fabricia

Teu código:

If DCount("*", "tblRegistrosSS", "DataInicial=#" & TxtData & "# and TagEquip='" & TxtEquip.Column(1) & "' and TPM='" & tlSource.Column(1) & "'") > 0 Then

Para podermos analisar teu código, precisa dar o nome aos bois.

Diga-nos o que é:
TagEquip.Colomun(1) - Caixa de combinação, caixa de listagem, quantas colunas, dados de cada coluna.
Idem para a tlSource.Column(1).

O código abaixo, é o que está usando?

Se sim, veja:


If DCount("*", "tblRegistrosSS", "DataInicial=#" & TxtData & "# and TagEquip='" & TxtEquip.Column(1) & "' and TPM='" & tlSource.Column(1) & "'") > 0 Then

   MsgBox "Registro já lançado..." & "Código Nº" & Código

   Cancel = True 'cancela o evento.
Else
   Me!TxtEquip.Undo
   Me!TxtData.Undo
   Me!tlSource.Undo 'desfaz a digitação.
   stLinkCriteria As String

   stLinkCriteria = Código
   DoCmd.OpenForm  "tblRegistrosSS", , , stLinkCriteria
End If


Compare com o teu.

Outro detalhe:

Utiliza-se Cancel=true quando a sub tem o cancel no argumento.
Exemplo:

Private Sub Form_Open(Cancel As Integer)
If DCount("*", "tblAdicionarOrcamento") = 0 Then
   MsgBox " Não existem registros a serem exibidos"
   Cancel = True
End If
End Sub

Se o argumento cancel não estiver entre os parênteses,
utilize: Exit Sub


[ ]'s

Uma alternativa é criar um índice composto pelos três campos na estrutura da tabela, definindo-o como exclusivo.

Obrigado colega Noobezinho pela dica, ele funcionou na busca de duplicidade perfeitamente.

Mais ainda assim não filtrou meu registro no formulário de acordo com o codigo encontrado na busca da duplicidade no DCount.

Eu preciso que Nº do Código apareça na msgbox e execute o filtro.


MsgBox "Registro já lançado..." & "Código Nº" & Código

stLinkCriteria = Código

DoCmd.OpenForm "tblRegistrosSS", , , stLinkCriteria

Por experiência, sugiro que não coloque
essa caixa de mensagem.
É um clique que o usuário irá fazer sem
necessidade, pois logo em seguida o formulário
irá abrir no registro

Para abrir o form. no registro:

DoCmd.OpenForm "tblRegistrosSS", , , "[Código]= " & Me.Código

Onde: [Código] = nome do campo na tabela

Me.Código = nome da caixa de texto

Se está começando a programar, outra dica:
Evite utilizar espaços e acentos em nomes de controles.
[ ]'s

Ola;

Na minha assinatura, o link "102 Códigos VBA Gratuitos..."

Código:
"Alerta e Mostra Registos Duplicados"

Fabrícia

Resolveu?

Não pessoal, tive dificuldades de entender o código, pois na minha BD são três criterios de busca.


vou disponibilizar a BD, se conseguem me ajudar.


O formulario é Registros no botão Adicionar(+) entra no formulario de adição de novo registro, preciso que ao sair do Campo Itens, informe se existe dados cadastrados nos três critérios:

Tabela(tblRegistrosSS) Formulário(FCad)
*DataInicial TxtData
*TagEquip TxtEquip
*TPM tlSource


E ao final abra o form "tblRegistrosSS" filtrado com o item duplicado.

Fabrícia

Não veio

Utilize o get.tt

Não precisa cadastrar para hospedar o arquivo.

Como é publico, sugiro que coloque senha no arquivo.rar.

Anexos do fórum, não estão funfando.

[ ]'s

Não consegui enviar minha BD.

Mas preciso necesseriamente do código que utilize os 3 criterios e abra a form a partir deles.

Veja o código do J Paulo adapte a sua necessidade.

Private Sub Form_Close()
On Error Resume Next
Dim db As DAO.Database, rst As DAO.Recordset
Dim strNome As String, strSaveName As String
Set db = CurrentDb()
Set rst = db.OpenRecordset("select * from nomedatabela order by campo1, campo2, campo3 ASC;")
If rst.BOF And rst.EOF Then
MsgBox "Não existem registros..."
Else
rst.MoveFirst
Do Until rst.EOF
strDupName = rst.Fields("campo1") & rst.Fields("campo2") & rst.Fields("campo3")
If strDupName = strSaveName Then
rst.Delete
Else
strSaveName = rst.Fields("campo1") & rst.Fields("campo2") & rst.Fields("campo3")
End If
rst.MoveNext
Loop
Set rst = Nothing
Set db = Nothing
End If
End Sub

Não resolveu amigo, pois o formulário em questão não está vinculado a tabela, somente envia as informações para a tabela atraves de um botão.

Fabricia

use o get.tt como disse.

Compacte o teu arquivo, dai é só clicar e arrastar pra página dele.

Nada resolvido, amigo .Noobezinho não consigo enviar o arquivo.


Pessoal, quanto dúvida, ela continua, pois meu formulario não está vinculado a tabela e preciso identificar duplicidade com 3 critérios e ao memso tempo abrir outra form com registro em questão.

Fabricia

O get está com problemas.

Utilize o mega, dropbox ou o MEO Cloud

Nesses, precisa se cadastrar antes

de hospedar o arquivo.

Aguardamos...

Lupercio Consegui adaptar seu codigo.
obrigado pessoal!

On Error Resume Next
Dim db As DAO.Database, rst As DAO.Recordset
Dim strNome As String, strSaveName As String
Set db = CurrentDb()
Set rst = db.OpenRecordset("select * from tblRegistrosSS order by DataInicial, TagEquip, TPM ASC;")
If rst.BOF And rst.EOF Then

Else
rst.MoveFirst
Do Until rst.EOF
strDupName = rst.Fields("DataInicial") & rst.Fields("TagEquip") & rst.Fields("TPM")

If strDupName = strSaveName Then
rst.Delete


Else
strSaveName = rst.Fields("DataInicial") & rst.Fields("TagEquip") & rst.Fields("TPM")
End If
rst.MoveNext
Loop
Set rst = Nothing
Set db = Nothing
End If