[Resolvido]Excluir registros depois de copiar tabela

Olá, estou tentando muitas adaptações no meu sistema até chegar a um formato mais amigável para o usuário. Com a ajuda dos colegas aqui do forum implementei um subformulario com caixas de seleção. Estou fazendo um teste: copiar os registros do subformulario em que as caixas de seleção estão marcadas para uma tabela que dei o nome de "tbHistorico". Essa cópia consegui fazer de barbada, pois o mestre Avelino já tinha um código pronto para isso(segue abaixo). Então pergunto: como se faz para excluir os mesmos registros marcados da tabela de origem após a cópia . A finalidade disso seria guardar registros do sistema que não estão em uso no momento, mas que no futuro podem ser acessados. Segue código:

Private Sub cmdGravar_Click()

Dim rs As DAO.Recordset
Dim tbl As DAO.Recordset
'Abre a tabela que receberá os dados
Set tbl = CurrentDb.OpenRecordset("tbHistorico")
'carrega os dados do subformulário
Set rs = SubFormularioCerti.Form.RecordsetClone
'Percorre os registros do subformulário um a um
Do While Not rs.EOF
If rs!Arquivado = True Then
'Copia os dados do subformulário para a tabela
tbl.AddNew
tbl!codCertificado = rs!codCertificado
tbl!Matricula = rs!Matricula
tbl!codCurso = rs!codCurso
tbl!codEntidade = rs!codEntidade
tbl!Arquivado = rs!Arquivado
tbl.Update

'nesse ponto tentei vários códigos mas nenhum deu certo

End If
'vai para o próximo registro do subformulário
rs.MoveNext
Loop
tbl.Close
rs.Close
Set tbl = Nothing
Set rs = Nothing
MsgBox "Dados copiados..."
End Sub

ALAN

O simples será:

Código:

CurrentDb.Execute "DELETE * FROM SuaTabelaOrigem WHERE Arquivado = True"

Olá JPaulo, coloquei o código que indicaste no trecho de código em que eu havia tentado antes. Mas, no teste que fiz marquei duas caixas de seleção do subformulario e copiou somente o primeiro registro para tabela destino e parou por ai.Não copiou o segundo registro marcado nem sequer excluiu um dos registros após a cópia.
Faz alguma diferença: o subformulario é carregado por uma Consulta e não por tabela específica; os relacionamentos do meu exemplo estão com as caixas de seleção marcadas para Integridade Referencial, Propagar Atualizações e Propagar Exclusões. Para teste: ao clicar no botão Arquivar habilita o Subformulario para edição e ao mesmo tempo desabilita o botão e habilita o botão Gravar. No botão Gravar é onde se encontra os códigos para realizar as cópias de registros para tbHistorico, e deletar da tabela origem; e finalmente desabilitar Gravar e bloquear novamente o subformulario. Para melhor entendimento segue o bd de exemplo em anexo....

ALAN

Ola;

Veja a funcionar;

Código:

Private Sub cmdGravar_Click()
Dim rs As DAO.Recordset
Dim tbl As DAO.Recordset
'Abre a tabela que receberá os dados
Set tbl = CurrentDb.OpenRecordset("tbHistorico")
'carrega os dados do subformulário
Set rs = SubFormularioCerti.Form.RecordsetClone

'Percorre os registros do subformulário um a um
Do While Not rs.EOF

  If rs!Arquivado = True Then
      'Copia os dados do subformulário para a tabela
      tbl.AddNew
          tbl!codCertificado = rs!codCertificado
          tbl!Matricula = rs!Matricula
          tbl!codCurso = rs!codCurso
          tbl!codEntidade = rs!codEntidade
          tbl!Arquivado = rs!Arquivado
      tbl.Update
      'depois de adicionar á tabela historico, deleta o reistro da tabela "tbCertificado" pelo "codCertificado"
      CurrentDb.Execute "DELETE * FROM tbCertificado WHERE codCertificado=" & rs!codCertificado & ""
      'atualiza os dados
      Me.Recalc
  End If
    'vai para o próximo registro do subformulário
    rs.MoveNext
Loop

tbl.Close: Set tbl = Nothing
rs.Close: Set rs = Nothing
MsgBox "Dados copiados..."
End Sub


Olá, pessoal!

Estou com um problema semelhante que não consigo resolver.
Preciso que o botão copie registros de uma tabela para uma temporária, e que depois de copiar, apague apenas esses registros da tabela de origem. Ao final disso, exporte a tabela temporária.

O meu código (abaixo) está excluindo os registros corretamente e exportando a tabela temporária também corretamente. O problema está na cópia dos registros, que não está ocorrendo.
Alguém sabe me ajudar, por favor?



Private Sub btExpApag_Click()
   Dim RstOrigem As DAO.Recordset
   Dim RstDestino As DAO.Recordset
   Dim strSSCC As String
   Dim hrInicio As Date

   Set RstOrigem = CurrentDb.OpenRecordset("SELECT * FROM Tbl_Geral")
   Set RstDestino = CurrentDb.OpenRecordset("SELECT * FROM temp_final")
   
  Do While Not RstOrigem.EOF
     If Not IsNull(DLookup("DataFinal", "Tbl_Geral")) Then
   RstDestino.AddNew
   RstDestino!Pedido = RstOrigem!Pedido
   RstDestino!DataReanalise = RstOrigem!DataReanalise
   RstDestino!DataFinal = RstOrigem!DataFinal
   RstOrigem.MoveNext
     Else
       RstOrigem.MoveNext

    End If
        RstOrigem.MoveNext
     
    Loop
    RstOrigem.Close: Set RstOrigem = Nothing
    RstDestino.Close: Set RstDestino = Nothing
    CurrentDb.Execute "DELETE * FROM Tbl_Geral WHERE DataFinal <> Null"
   DoCmd.OutputTo acOutputTable, "temp_final", "MicrosoftExcelBiff8(*.xls)", "", False, "", 0

MsgBox "Exportação concluída com sucesso!", vbInformation
End Sub



Obrigada!

Ola Isabella, que bom vê-la de novo por aqui;

Tente fazer o simples e vai ver que funfa na boa;

Código:

Private Sub btExpApag_Click()
Dim i%
'verifica se tem registros com a data final preenchida
i = DCount("*", "Tbl_Geral", "DataFinal <> Null")
'se tiver, avança
    If i > 0 Then
'insere na tabela temporaria
        CurrentDb.Execute "INSERT INTO temp_final SELECT * FROM Tbl_Geral WHERE DataFinal <> Null"
'deleta na origem
        CurrentDb.Execute "DELETE * FROM Tbl_Geral WHERE DataFinal <> Null"
'exporta
        DoCmd.OutputTo acOutputTable, "temp_final", "MicrosoftExcelBiff8(*.xls)", "", False, "", 0
'informa o usuário
        MsgBox "Exportação concluída com sucesso!", vbInformation
        Else
'se não, morre aqui
        Exit Sub
    End If
End Sub


Olá, JPaulo!

Obrigada

Uauuu, funcionou direitinho e muito mais rápido.
Muito obrigada pela ajuda!
Um abraço.

Fico feliz, obrigada.

Vamos aguardar o retorno do ALAN.

Bom dia JPaulo, de acordo com o que passaste acima fez a copia certinho, exclui da origem certinho também, só que quando chegou na parte do "rs.MoveNext" deu erro de "objeto inválido ou não definido", mas o recordset está definido no inicio do código: Dim rs As DAO.Recordset. O que pode ser???

ALAN

Mas copiou todos os registros ou só um ?

O SubFormulário é carregado com registros "Arquivado" ou não. Então o registro que preciso fazer a cópia eu seleciono em uma Caixa de Seleção ao lado de cada registro. No caso fiz o teste selecionando apenas um registro...

ALAN

Amigão, aqui funcionou perfeito;

1º Arquivar
2º Gravar

Download

JPaulo, conforme comentei antes, tá copiando e excluindo normal (Arquivar, Gravar). Tanto o meu bd que postei anteriormente, quanto o seu que disponibilizou acima, aqui não chega executar o LOOP. Se fazer uma seleção com mais de um registro, faz todo processo beleza com o primeiro mas quando vai para o próximo dá erro e para. "ERRO 3420 Objeto não é válido ou não está definido"; e marca em amarelo a linha "rs.MoveNext"....

ALAN

Ola;

Pequena alteração.
Teste e retorne por favor;

Download

Código:

Private Sub cmdGravar_Click()
Dim rs As DAO.Recordset
Dim tbl As DAO.Recordset
Dim intConta%
'verifica se a tabela original tem registros
intConta = DCount("*", "tbCertificado")
'se não tem, morre aqui
If intConta = 0 Then Exit Sub

'Abre a tabela que receberá os dados
Set tbl = CurrentDb.OpenRecordset("tbHistorico")
'carrega os dados do subformulário
Set rs = Me.SubFormularioCerti.Form.RecordsetClone
'Percorre os registros do subformulário um a um
With rs
    .MoveFirst
    Do While Not .EOF
      If !Arquivado = True Then
      'Copia os dados do subformulário para a tabela
      tbl.AddNew
          tbl!codCertificado = rs!codCertificado
          tbl!Matricula = rs!Matricula
          tbl!codCurso = rs!codCurso
          tbl!codEntidade = rs!codEntidade
          tbl!Arquivado = rs!Arquivado
      tbl.Update
      'depois de adicionar á tabela historico, deleta o reistro da tabela "tbCertificado" pelo "codCertificado"
      CurrentDb.Execute "DELETE * FROM tbCertificado WHERE codCertificado=" & rs!codCertificado & ""
      'atualiza os dados
      Me.Recalc
  End If
    'vai para o próximo registro do subformulário
      .MoveNext
    Loop
End With
Set rs = Nothing
MsgBox "Registros adicionados com sucesso.", vbInformation, "Sucesso"
End Sub

JPAULO, mesmo copiando só o trecho do código ou copiando o bd em anexo com as alterações que propuseste, aqui pra mim da erro sempre no mesmo trecho do código ..MoveNext...Se for uma seleção de mais de um registro copia o primeiro normalmente e trava no segundo...Vou revisar tudo novamente, e refazer, se continuar assim vou mudar a maneira como é arquivado os registros tentando uma forma mais simples. De momento agradeço imensamente a atenção...

ALAN

Amigo, aqui funciona perfeito.
Marcando um ou mais.

Mestre JPAULO, para nós não ficarmos presos em um "loop" igual ao código que estamos analisando, vou marcar como resolvido esse tópico. Qualquer novidade à respeito volto a informar. Sendo assim, agradeço a disponibilidade em analisar o meu código. Um abraço, e até mais...

ALAN