Alexandre Neves- Moderador Global
- Respeito às regras :
Sexo : 
Localização : 
Mensagens : 8498
Registrado : 05/11/2009
Alexandre Neves 16/11/2020, 10:02
Bom dia
Nomeie de forma normalizada. Declare as variáveis explicitamente. Ajuda muito na hora de ler/interpretar o código
Veja se o código funciona como pretende (adapte para o tipo de dados nos campos texto)
- Código:
Private Sub Comando1_Click()
Dim rDup As DAO.Recordset
Dim txtNomPro
Set db = CurrentDb()
Set rs = db.OpenRecordset("tbl_Produtos")
strSQL = "SELECT * FROM xmlProdutos WHERE SELECIONAR = -1"
Set Rst = db.OpenRecordset(strSQL)
txtCodPro = Nz(DMax("CODPRO", "tbl_Produtos"), 0) + 1
Do While Not Rst.EOF
Set rDup = CurrentDb.OpenRecordset("SELECT * FROM tbl_Produtos WHERE CODPROFOR=" & Rst("ccVarPro") & " AND ccNomPro =" & Rst("ccNomPro") & " and ccMEDIDA =" & Rst("ccMedida") & " and ccNCM=" & Rst("ccNCM") & " and ccPreçoCusto =" & Rst("CUSTO") & " and ccnFCI =" & Rst("ccnFCI") & " and ccinfAdProd=" & Rst("ccinfAdProd") & " and ccOrigem=" & Rst("ccorig") & " and ccPreçoCustoFinal=" & Rst("CUSTO") & " and ccPreçoVenda=" & Rst("CUSTO") & " and XMLDESC=" & Rst("ccVarPro") & Rst("ccNomPro") & Rst("ccinfAdProd"))
If rDup.EOF = False Then GoTo NaoRegista
rs.AddNew
rs("CODPRO") = txtCodPro
rs("ccVarPro") = Format(txtCodPro, "00000")
rs("CODPROFOR") = Rst("ccVarPro")
rs("ccNomPro") = Rst("ccNomPro")
txtNomPro = Rst("ccNomPro")
rs("ccMEDIDA") = Rst("ccMedida")
rs("ccNCM") = Rst("ccNCM")
Dim txtNCM
txtNCM = Rst("ccNCM")
rs("ccPreçoCusto") = Rst("CUSTO")
rs("ccnFCI") = Rst("ccnFCI")
Dim txtnFCI
txtnFCI = Rst("ccnFCI")
rs("ccinfAdProd") = Rst("ccinfAdProd")
rs("ccOrigem") = Rst("ccorig")
rs("ccTipo") = 2
rs("CODGRUPO") = 1
rs("ccCFOP") = 5102
rs("ccCST") = "000"
rs("ccCSOSN") = 101
rs("ccCOFINS") = 0
rs("ccCOFINSCST") = "49"
rs("ccPIS") = 0
rs("ccPISCST") = "49"
rs("ccIPI") = 0
rs("ccIPICST") = 99
rs("ccPreçoCustoFinal") = Rst("CUSTO")
rs("ccPreçoVenda") = Rst("CUSTO")
rs("cccEnq") = 999
rs("cdDatCad") = Format(Now(), "dd/mm/yyyy")
rs("ccPrecoPauta") = "0,00"
'----------------------------------------------------------
rs("ccICMSENTRADA") = 0
rs("ccICMSSAIDA") = 0
rs("ccCUSTOOPERACIONAL") = 0
rs("ccOUTROSIMPOSTOS") = 0
rs("ccCOMISSAO") = 0
rs("ccPrecoPauta") = 0
rs("ccMVA") = 0
rs("ccMargemLucro") = 0
rs("ccNívelEstoque") = 0
'-------------------------------------------
rs("ccTipoFator") = 0
rs("xTipoFator") = "Dividir por"
rs("CODFORN") = txtCGC
rs("ccFatorConversao") = 1
rs("ccEstoque") = 0
rs("ccMargemDesconto") = 0
rs("ccTipoGrade") = 1
rs("XMLDESC") = Rst("ccVarPro") & Rst("ccNomPro") & Rst("ccinfAdProd")
rs("ccAtivo") = True
rs.Update
Rst.MoveNext
' Me.CODIGO = txtCodPro
' Me.Nome = txtNomPro
Me.Requery
Me.Repaint
Me.Refresh
txtCodPro = txtCodPro + 1
NaoRegista:
Loop
rs.Close
MsgBox "Dados Copiados com Sucesso!"
Me.Requery 'Chamon 28-10-2020
End Sub
.................................................................................
Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo
Início
![[Resolvido]Função para não copiar dados duplicados Empty](https://2img.net/i/empty.gif)
![[Resolvido]Função para não copiar dados duplicados Attachment](https://2img.net/i/fa/attachment.png)
Copiar Dados Duplicados.zip