[Resolvido]Erro em VBA para Excluir Registros Duplicados

Essa é para o amigo JPaulo

Estou usando este exemplo do forum a qual vc disponibilizou para um de nossos caros usuários.
Achei interessando e resolvi utilizar em meus projetos.

Fiz conforme sugerido e ele apresenta o seguinte erro:
Erro em Tempo de Execução 3075:
Erro de sintaxe (operador faltando) na expressão de Consulta 'Numero Conta'.

e Destaca a linha no VBA conforme abaixo:

o que fiz de errado??

Utilizei conforme orientado....segue abaixo exemplo do JPaulo a qual coletei do forum:

-------------------------------------------------------------------------------------------------------------------
Com este código, jamais irá ter duplicidade nas suas tabelas, apenas deve informar o nome da tabela, na chamada da função, assim:

Private Sub SeuBotao_Click()
Call DeletaRegistrosDuplicados("APARTAMENTO")
End Function

Cole num módulo novo e salve:


Public Function DeletaRegistrosDuplicados(strTabela As String)
'By JPaulo ® Maximo Access
Dim rst As DAO.Recordset, rst2 As DAO.Recordset
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim strSQL As String
Dim varX As Variant

Set tdf = DBEngine(0)(0).TableDefs(strTabela)
strSQL = "SELECT * FROM " & strTabela & " ORDER BY "
For Each fld In tdf.Fields
If (fld.Type <> dbMemo) And (fld.Type <> dbLongBinary) Then
strSQL = strSQL & fld.Name & ", "
End If
Next fld

strSQL = Left(strSQL, Len(strSQL) - 2)
Set tdf = Nothing

Set rst = CurrentDb.OpenRecordset(strSQL)
Set rst2 = rst.Clone
rst.MoveNext
Do Until rst.EOF
varX = rst.Bookmark
For Each fld In rst.Fields
If fld.Value <> rst2.Fields(fld.Name).Value Then
GoTo NextRecord
End If
Next fld
rst.Delete
GoTo SkipBookmark
NextRecord:
rst2.Bookmark = varX
SkipBookmark:
rst.MoveNext
Loop
rst.Close
MsgBox "Registros duplicados encontrado(s) e deletados com sucesso...", vbInformation
End Function

Faça o teste alterando o nome do seu campo,

De:

Numero Conta

Para:

NumeroConta

E veja o que acontece...

Mesmo erro....

destaca sempre essa linha:

Set rst = CurrentDb.OpenRecordset(strSQL)

inclusive ajustei na origem da linha SQL:

SELECT tblContas.IDCad_Contas, tblContas.NumeroConta
FROM tblContas
ORDER BY tblContas.IDCad_Contas;

Mas você não tem que fazer esse SQl, o codigo já faz;

Fiz aqui o teste, e com o nome do campo em separado dá erro, junto não dá mais e funfa bem.

caro JPaulo

Estou efetuando alguns testes ainda....

assim que tiver uma posição te informo....

Caro JPaulo

o que fiz após alterar os campos da tabela conforme sua sugestão, foi compactar o bd.

só que agora apareceu um novo erro:

Erro em tempo de execução 3829

o campo Anexo de valores múltiplos não pode ser usado em uma
cláusula ORDER BY.

Será que não poder ser executado em tabelas com campo anexo?

Tem de acrescentar esse formato para ser ignorado no Order By

If (fld.Type <> dbMemo) And (fld.Type <> dbLongBinary) And (fld.Type <> dbAttachment) Then

Estou enviando todo o código do módulo:

não esta dando certo, desculpe minha falta de conhecimento em vb.
agora diz que a uma expressão faltando Next sem For.
também não sei que acrescentei ao certo a linha a qual vc enviou.....segue abaixo

Public Function DeletaRegistrosDuplicados(strTabela As String)
'By JPaulo ® Maximo Access
Dim rst As DAO.Recordset, rst2 As DAO.Recordset
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim strSQL As String
Dim varX As Variant

Set tdf = DBEngine(0)(0).TableDefs(strTabela)
strSQL = "SELECT * FROM " & strTabela & " ORDER BY "
For Each fld In tdf.Fields
If (fld.Type <> dbMemo) And (fld.Type <> dbLongBinary) Then
If (fld.Type <> dbMemo) And (fld.Type <> dbLongBinary) And (fld.Type <> dbAttachment) Then
strSQL = strSQL & fld.Name & ", "
End If
Next fld

strSQL = Left(strSQL, Len(strSQL) - 2)
Set tdf = Nothing

Set rst = CurrentDb.OpenRecordset(strSQL)
Set rst2 = rst.Clone
rst.MoveNext
Do Until rst.EOF
varX = rst.Bookmark
For Each fld In rst.Fields
If fld.Value <> rst2.Fields(fld.Name).Value Then
GoTo NextRecord
End If
Next fld
rst.Delete
GoTo SkipBookmark
NextRecord:
rst2.Bookmark = varX
SkipBookmark:
rst.MoveNext
Loop
rst.Close
MsgBox "Registros duplicados encontrado(s) e deletados com sucesso...", vbInformation
End Function

Você só tem de acrescentar o And (fld.Type <> dbAttachment) à linha já existente, não pode duplicar.

alteração feita mas apresentando Novo erro...

Erro em tempo de execução 3061

Parâmentros insuficientes. Eram esperados 2

mandando depurar a seguinte linha:

Set rst = CurrentDb.OpenRecordset(strSQL)

Grande Marcelo, pelos teste que fiz aqui funfa.

Se preferir coloque aqui parte do seu banco para analisarmos.

Segue arquivo

senha

O problema está nos carateres especiais que você tem nos nomes dos campos na tabela;

http://dl.dropbox.com/u/771097/Finana_OLD.rar

Ok JPaulo

Entendi....

Fiz o teste em meu projeto e deu certo.....
Compreendi que devo ter cuidado em nome dos campos de tabela em projetos futuros, para evitar tais problemas utilizando VBA.

Obrigado pela atenção
Estou aprendendo muito com vc...

até....

Obrigado pelo retorno o forum agradece.

Já agora mude o seu Avatar, esse assusta....

Sei que houve varias repetiçoes sobre o assunto.
Mas gostaria de uma opniao.
O modulo em questao realiza todo processo correto.
Porem ele so verifica estas dupicidades se os valores dos campos nao tiverem espaço.
Ex: Nome Completo (a função da erro)
NomeCompleto (a função realiza com sucesso.

Tem como permitir que esta função realize este trabalho, tendo os campos espaços entre os nomes ?