[Resolvido]Inserto Into falha as vezes .

Boa noite .

tenho o código abaixo, onde tem a instrução "INSERT INTO" executando a cada loop da tabela VendaItens, mas as vezes o Insert falha.
exemplo tem 04 registro na tabela 03 insere novo registro e um falha, não é com frequencia que acontece
um detalhe que tenho 12 pc em rede executando o programa, será que pode ser algum bloqueio de registro ?
e o código abaixo o insert no meio de Do While , do Loop,  pode  ser usado  ?

Dim db As DAO.Database

Set db = CurrentDb
Dim RSB As DAO.Recordset
Dim strSQl As String
strSQl = "SELECT PRODUTOS.CodigoDoProduto, PRODUTOS.Loja1, PRODUTOS.Loja2, VENDAITENS.Quantidade, VENDAITENS.ValorUni, VENDAITENS.CodVenda from PRODUTOS INNER JOIN VENDAITENS ON PRODUTOS.CodigoDoProduto = VENDAITENS.CodProduto WHERE CodVenda = " & Me.CodVenda & ""
Set RSB = db.OpenRecordset(strSQl)

RSB.MoveFirst
Do While Not RSB.EOF
RSB.Edit

   
   
   DoCmd.RunSQL "INSERT INTO PRODUTOSHISTORICO" & _
   "(Estoque, DataVenda, Codigodoproduto, Saida, Descrição, CodVenda, Funcionário, CódigoDoCliente, ValorVenda) VALUES" & _
   "( '" & RSB("Loja1") - RSB("Quantidade") & "', Now, '" & RSB("CodigoDoProduto") & "', '" & RSB("Quantidade") & "', 'Vendido', CodVenda, Funcionário, " & Cliente.Column(1) & ", '" & RSB("ValorUni") - (RSB("ValorUni") * Desconto) & "');"

   RSB("loja1") = RSB("loja1") - RSB("Quantidade")


RSB.Update
RSB.MoveNext
Loop
RSB.Close
Set RSB = Nothing

Boa noite
O insert no meio dos ciclos pode ser sem problemas
Sobre o possível bloqueio de registo, não lhe sei dizer

Boa noite Alexandre , obrigado por responder , acredito que deve ser algum bloqueio onde por coincidência algum usuário deve estar editando o mesmo registro , ja andei revendo todos os códigos vendo se após a execução deles estão fechadas (Nothing, close), talvez por estar em rede pode ter alguma demora de respostas com execução do código , e fica aberto com tempo superior ao normal , são uns 30 mil registro para uns 12 usuário , é muita coincidência o mesmo usuário estar no mesmo registro no mesmo segundo .... , e como falei acontece de forma rara, mas acontece , e acaba criando uma falha no registro,

Egnaldo boa noite,

O código estava com alguns erros na sintaxe de INSERT.

Fiz uns ajustes conforme abaixo:

Código:



Private Sub Gravar()
On Error GoTo trata_erro
Dim db          As DAO.Database
Dim rsb        As DAO.Recordset
Dim strSQl      As String
Dim sSQL        As String
Dim vVlrVenda  As String
Dim iQtdLoja    As Integer

   
    Set db = CurrentDb
    strSQl = "SELECT "
    strSQl = strSQl & "  PRODUTOS.CodigoDoProduto"
    strSQl = strSQl & " ,PRODUTOS.Loja1"
    strSQl = strSQl & " ,PRODUTOS.Loja2"
    strSQl = strSQl & " ,VENDAITENS.Quantidade"
    strSQl = strSQl & " ,VENDAITENS.ValorUni"
    strSQl = strSQl & " ,VENDAITENS.CodVenda "
    strSQl = strSQl & " FROM PRODUTOS "
    strSQl = strSQl & " INNER JOIN VENDAITENS ON PRODUTOS.CodigoDoProduto = VENDAITENS.CodProduto "
    strSQl = strSQl & " WHERE CodVenda = " & Me.CodVenda & ""

    Set rsb = db.OpenRecordset(strSQl, dbOpenSnapshot)
    rsb.MoveFirst
   
    Do While Not rsb.EOF
        vVlrVenda = Format(rsb("ValorUni") - (rsb("ValorUni") * rsb("Desconto")), "#,##0.0#")
        iQtdLoja = Nz((rsb("loja1") - rsb("Quantidade")), 0)
       
        'rsb.Edit
       
        '-- Insere da tabela Historico -------------------------------------------
        sSQL = "INSERT INTO PRODUTOSHISTORICO "
        sSQL = sSQL & " ("
        sSQL = sSQL & "  Estoque"
        sSQL = sSQL & " ,DataVenda"
        sSQL = sSQL & " ,Codigodoproduto"
        sSQL = sSQL & " ,Saida"
        sSQL = sSQL & " ,Descrição"
        sSQL = sSQL & " ,CodVenda"
        sSQL = sSQL & " ,Funcionário"
        sSQL = sSQL & " ,CódigoDoCliente"
        sSQL = sSQL & " ,ValorVenda"
        sSQL = sSQL & " )"
        sSQL = sSQL & " VALUES "
        sSQL = sSQL & "("
        sSQL = sSQL & " '" & rsb("Loja1") - rsb("Quantidade") & "'"
        sSQL = sSQL & " ,Now"
        sSQL = sSQL & " ,'" & rsb("CodigoDoProduto") & "'"
        sSQL = sSQL & " ,'" & rsb("Quantidade") & "'"
        sSQL = sSQL & " ,'Vendido'"
        sSQL = sSQL & " ,CodVenda"    '--> Isso é um campo do formulário? Verificar...
        sSQL = sSQL & " ,Funcionário" '--> Isso é um campo do formulário? VErificar...
        sSQL = sSQL & " ," & Cliente.Column(1) & ""
        sSQL = sSQL & " ,'" & vVlrVenda & "'"
        sSQL = sSQL & " );"
        db.Execute sSQL
       
        '--Atualiza dados --------------------------------------------------------
        sSQL = "UPDATE PRODUTOS SET"
        sSQL = sSQL & " loja1 = " & iQtdLoja & ""
        sSQL = sSQL & " WHERE CodVenda = " & Me.CodVenda & ""
        sSQL = sSQL & " AND CodProduto = '" & rsb("Codigodoproduto") & "'"
        db.Execute sSQL
       
        'rsb.Update
        rsb.MoveNext
    Loop
   
    rsb.Close
    Set rsb = Nothing

    Exit Sub
   
trata_erro:
    MsgBox "Erro gerado: " & Err.Number & " - " & Err.Description & "", vbCritical, "Erro!!!"
    Exit Sub


End Sub


Sem a cópia do banco de dados fica mais difícil de testar, mas veja se o código acima funciona.
Veja nos comentários do código, pois existem algumas dúvidas sobre os campos.


Espero ter ajudado.

[]'s

FIM

Joia, vou verificar e aplicar aqui, em breve retorno, obrigado .

Boa tarde, refiz algumas alterações, agora somente esperar o tempo dizer se haverá alguma falha, agradeço a Alexandre Fim, e Alexandre Neves, e ao Forum , obrigado !

Valeu Egnaldo !!!

O fórum agradece!!!
Sucesso !!!