[Resolvido]update não exporta todos os campos do sub formulário !

Boa tarde.

Recorro novamente aos Grandes colaboradores do fórum.

Estou em fase de desenvolvimento de um projeto e me deparei com um problema:

O código abaixo não está exportando os dados do subformulário para a tabela especifica ( suborcAP ). Ele exporta apenas a primeira linha e as demais não. Sinceramente eu já olhei isso de fora a fora...será que falta alguma coisa nele ? tipo loop, next....sinceramente eu não sei mesmo.

Agradeço a colaboração dos colegas e o tempo doado a minha duvida.

Grato

OrcAprovado_Click()
Dim db1 As Database, db2 As Database, rs1 As DAO.Recordset, rs2 As DAO.Recordset
If MsgBox("Cliente aprovou a realização desse pedido ?", vbYesNo + vbQuestion, "xxxxxxx") = vbYes Then

Set db1 = CurrentDb
Set db2 = CurrentDb
Set rs1 = db1.OpenRecordset("OrcAP", dbOpenTable)
Set rs2 = db2.OpenRecordset("suborcAP", dbOpenTable)


With rs1

.AddNew

![IdOrcamento] = Me.IdOrcamento
![DataPedido] = Me.DataPedido
![PedidoReferente] = Me.PedidoReferente
![Idcliente] = Me.Idcliente
![Nome] = Me.Nome
![PedidoReferente] = Me.PedidoReferente
![Tmaoobra] = Me.Tmaoobra
![Tpecas] = Me.Tpecas
![Tgeral] = Me.Tgeral
![PrazoEntrega] = Me.PrazoEntrega
![FormadePgto] = Me.cboFpgto
![DtPgto] = Me.DtPgto
![VPgto] = Me.VPgto
![DtPgto1] = Me.DtPgto1
![VPgto1] = Me.VPgto1
![DtPgto2] = Me.DtPgto2
![VPgto2] = Me.VPgto2
![DtPgto3] = Me.DtPgto3
![VPgto3] = Me.VPgto3
![DtPgto4] = Me.DtPgto4
![VPgto4] = Me.VPgto4
![DtPgto5] = Me.DtPgto5
![VPgto5] = Me.VPgto5
![DtPgto6] = Me.DtPgto6
![VPgto6] = Me.VPgto6
![DtPgto7] = Me.DtPgto7
![VPgto7] = Me.VPgto7
.Update
End With

With rs2
.AddNew

![Idsuborc] = Forms![Frmorc]![subOrc]!Idsuborc
![Cod] = Forms![Frmorc]![subOrc]!Cod
![Descricao] = Forms![Frmorc]![subOrc]!Descricao
![Qtd] = Forms![Frmorc]![subOrc]!Qtd
![prcusto] = Forms![Frmorc]![subOrc]!prcusto
![Margemlucro] = Forms![Frmorc]![subOrc]!Margemlucro
![Vunitario] = Forms![Frmorc]![subOrc]!Vunitario
![Vtotal] = Forms![Frmorc]![subOrc]!Vtotal
.Update
End With

DoCmd.RunCommand acCmdDeleteRecord
DoCmd.RunCommand acCmdRefresh
DoCmd.GoToRecord , , acNewRec

MsgBox "Confirmada a aprovação desse pedido pelo cliente !", vbOKOnly + vbInformation, "xxxxx"

End If
End Sub]

Boas Silvio... Se deseja exportar os dados do sub-form, porque não utiliza o RecordstClone para carregar o recordset com os dados do sub-form, depois o Do While..


Do While Not Rs.EOF

codigos..


Rs.MoveNext
Loop

Da maneira como está so exportará uma linha... Deves primeiramente carregar um recordset com os dados do subform..

Rs1 >>> dados do Subform (conseguido através do recordset clone)
Rs2 e Rs 3... para as tabelas que irá inserir..

Mas creio que a melhor solução seria:

Carregar o Recordset com os dados do subform atraves do recordset clone....
E na instrução o CurrentDb.Execute "Insert Into blablabla" (na tabela que deseja inserir


Do While Rs.EOF

CurrentDb.Execute "Insert Into ........" (Instrução de inserção)


Rs.MoveNext
Loop


Cumprimentos.

Boas Piloto...grato por me responder....

Pode você me dar um força.....como eu faria isso ??

Estou um pouco longe da tua sabedoria...risos !!

Abraços

Boas Silvio... não estou com o not no momento... dia 22 estarei com ele e lhe auxilio com isto. Poste a parte do BD.

Cumprimentos.

Boas Piloto.....


Então....esse código esta numa caixa sim/não. Quando selecionada dispara o código acima, onde rs1 é uma tabela e rs2 é outra.

Ambas estão relacionadas 1-n ( orcap - suborcap )

A "zica" está em rs2 que exporta apenas a primeira linha do subformulário e as demais não vão nem a "pau".

Em rs2 estou a utilizar o seguinte código: ( ver minha outra mensagem onde está o código completo )
With rs2
.AddNew

![Idsuborc] = Forms![Frmorc]![subOrc]!Idsuborc
![Cod] = Forms![Frmorc]![subOrc]!Cod
![Descricao] = Forms![Frmorc]![subOrc]!Descricao
![Qtd] = Forms![Frmorc]![subOrc]!Qtd
![prcusto] = Forms![Frmorc]![subOrc]!prcusto
![Margemlucro] = Forms![Frmorc]![subOrc]!Margemlucro
![Vunitario] = Forms![Frmorc]![subOrc]!Vunitario
![Vtotal] = Forms![Frmorc]![subOrc]!Vtotal
.Update
End With


Sinceramente, eu não sei nem como fazer oque vc me pediu.....não tenho habilidade e experiência em VBA ainda, como você tem.

Se puder, me orientar....sinceramente eu ficaria muito agradecido.

Abraços.....

Silvio

Qualquer coisa assim;



Private OrcAprovado_Click()
Dim db1 As Database, db2 As Database, rs1 As DAO.Recordset, rs2 As DAO.Recordset
If MsgBox("Cliente aprovou a realização desse pedido ?", vbYesNo + vbQuestion, "xxxxxxx") = vbYes Then

Set db1 = CurrentDb
Set db2 = CurrentDb
Set rs1 = db1.OpenRecordset("OrcAP", dbOpenTable)
Set rs2 = db2.OpenRecordset("suborcAP", dbOpenTable)


With rs1
.MoveFirst

Do While Not .EOF

.AddNew

![IdOrcamento] = Me.IdOrcamento
![DataPedido] = Me.DataPedido
![PedidoReferente] = Me.PedidoReferente
![Idcliente] = Me.Idcliente
![Nome] = Me.Nome
![PedidoReferente] = Me.PedidoReferente
![Tmaoobra] = Me.Tmaoobra
![Tpecas] = Me.Tpecas
![Tgeral] = Me.Tgeral
![PrazoEntrega] = Me.PrazoEntrega
![FormadePgto] = Me.cboFpgto
![DtPgto] = Me.DtPgto
![VPgto] = Me.VPgto
![DtPgto1] = Me.DtPgto1
![VPgto1] = Me.VPgto1
![DtPgto2] = Me.DtPgto2
![VPgto2] = Me.VPgto2
![DtPgto3] = Me.DtPgto3
![VPgto3] = Me.VPgto3
![DtPgto4] = Me.DtPgto4
![VPgto4] = Me.VPgto4
![DtPgto5] = Me.DtPgto5
![VPgto5] = Me.VPgto5
![DtPgto6] = Me.DtPgto6
![VPgto6] = Me.VPgto6
![DtPgto7] = Me.DtPgto7
![VPgto7] = Me.VPgto7
.Update

.MoveNext
Loop
End With


With rs2
.MoveFirst

Do While Not .EOF
.AddNew

![Idsuborc] = Forms![Frmorc]![subOrc]!Idsuborc
![Cod] = Forms![Frmorc]![subOrc]!Cod
![Descricao] = Forms![Frmorc]![subOrc]!Descricao
![Qtd] = Forms![Frmorc]![subOrc]!Qtd
![prcusto] = Forms![Frmorc]![subOrc]!prcusto
![Margemlucro] = Forms![Frmorc]![subOrc]!Margemlucro
![Vunitario] = Forms![Frmorc]![subOrc]!Vunitario
![Vtotal] = Forms![Frmorc]![subOrc]!Vtotal
.Update

.MoveNext
Loop
End With

DoCmd.RunCommand acCmdDeleteRecord
DoCmd.RunCommand acCmdRefresh
DoCmd.GoToRecord , , acNewRec

MsgBox "Confirmada a aprovação desse pedido pelo cliente !", vbOKOnly + vbInformation, "xxxxx"

End If
End Sub

Jpaulo...um bom dia e uma boa semana de trabalho !

Grato por ter respondido, você como sempre é um grande mestre mesmo.

Porém meu caro e grande tenho que lhe reportar que deu o seguinte erro: erro em tempo de execução 3021, justamente na linha .movefirst do rs1.

Já tirei o movefirst, já compactei e reparei...e nada.

Estou mais perdido que o cachorro que caiu do caminhão de mudanças....

Se possível lhe for, conto com a tua experiência e ajuda nesse caso.

Segue anexo o problema que eu estou a viver hoje.

Ola Silvio, quer testar o simples ?

Private Sub OrcAprovado_Click()
Dim strSQL As String, strSQL1 As String

    If MsgBox("Cliente aprovou a realização desse pedido ?", vbYesNo + vbQuestion, "xxxxxxx") = vbNo Then
    Me.OrcAprovado.Value = 0
    Exit Sub
        Else
    DoCmd.Save
    strSQL = "INSERT INTO OrcAP SELECT * FROM tblorc WHERE IdOrcamento=" & Me.IdOrcamento.Value
    strSQL1 = "INSERT INTO subOrcAP SELECT * FROM tblSuborc WHERE Idsuborc=" & Me.IdOrcamento.Value
    CurrentDb.Execute strSQL
    CurrentDb.Execute strSQL1

    MsgBox "Confirmada a aprovação desse pedido pelo cliente !", vbOKOnly + vbInformation, "xxxxx"
    DoCmd.RunCommand acCmdRefresh
    DoCmd.GoToRecord , , acNewRec
End If
End Sub

Grande Mestre JPaulo....

O simples funciona !!!

Perfeito meu caro.

Vou aplicar ele e estudar um pouco mais de SQL.

Abraços e muito..mas muito obrigado mesmo !

Silvio

Obrigado pelo retorno o fórum agradece.

JPaulo, é possível incluir uma linha para deletar os arquivos importados da tabela de origem ?

Concerteza;

Private Sub OrcAprovado_Click()
Dim strSQL As String, strSQL1 As String, strSQL2 As String, strSQL3 As String

    If MsgBox("Cliente aprovou a realização desse pedido ?", vbYesNo + vbQuestion, "xxxxxxx") = vbNo Then
    Me.OrcAprovado.Value = 0
    Exit Sub
        Else
    DoCmd.RunCommand acCmdSaveRecord
    strSQL = "INSERT INTO OrcAP SELECT * FROM tblorc WHERE IdOrcamento=" & Me.IdOrcamento.Value
    strSQL1 = "INSERT INTO subOrcAP SELECT * FROM tblSuborc WHERE Idsuborc=" & Me.IdOrcamento.Value
    strSQL2 = "DELETE * FROM tblorc WHERE IdOrcamento=" & Me.IdOrcamento.Value
    strSQL3 = "DELETE * FROM tblSuborc WHERE Idsuborc=" & Me.IdOrcamento.Value
    
    CurrentDb.Execute strSQL
    CurrentDb.Execute strSQL1
    CurrentDb.Execute strSQL2
    CurrentDb.Execute strSQL3

    MsgBox "Confirmada a aprovação desse pedido pelo cliente !", vbOKOnly + vbInformation, "xxxxx"
    DoCmd.RunCommand acCmdRefresh
    DoCmd.GoToRecord , , acNewRec
End If
End Sub

Faça antes assim, para não aparecer os registros deletados nos forms;

Private Sub OrcAprovado_Click()
Dim strSQL As String, strSQL1 As String, strSQL2 As String, strSQL3 As String

    If MsgBox("Cliente aprovou a realização desse pedido ?", vbYesNo + vbQuestion, "xxxxxxx") = vbNo Then
    Me.OrcAprovado.Value = 0
    Exit Sub
        Else
    DoCmd.RunCommand acCmdSaveRecord
    strSQL = "INSERT INTO OrcAP SELECT * FROM tblorc WHERE IdOrcamento=" & Me.IdOrcamento.Value
    strSQL1 = "INSERT INTO subOrcAP SELECT * FROM tblSuborc WHERE Idsuborc=" & Me.IdOrcamento.Value
    CurrentDb.Execute strSQL
    CurrentDb.Execute strSQL1
    
        MsgBox "Confirmada a aprovação desse pedido pelo cliente !", vbOKOnly + vbInformation, "xxxxx"
        
    strSQL2 = "DELETE * FROM tblorc WHERE IdOrcamento=" & Me.IdOrcamento.Value
    strSQL3 = "DELETE * FROM tblSuborc WHERE Idsuborc=" & Me.IdOrcamento.Value
    
    CurrentDb.Execute strSQL2
    CurrentDb.Execute strSQL3

    DoCmd.RunCommand acCmdRefresh
    DoCmd.GoToRecord , , acNewRec
End If
End Sub

Olá Silvio, teria como postar a parte do BD dinovo só que com a alteração que o mestre JP lhe enviou, estava querendo adaptar seu form de orçamento no minha bd, só que não consegui associar a instrução do mestre JP para parar de dar erro.

Jpaulo.....tu é mestre mesmo !

Anderson_cgms eis o banco, o código está em FrmORC, por favor manter os créditos que estão nele.

Abraços a todos.

Muito obrigado Silvio, quanto aos créditos não se preocupe, pois de a César o que é de César, rsrsrs.

Valeu anderson...qualquer coisa estou por aqui se precisar de algo

Abraços e bons estudos para ti.

Silvio