[Resolvido]Erro no atualizar estoque

o Banco é divido em BE e FE, acontece que ao vincular as tabelas o código da erro

na linha: rstEstoque.Index = "PrimaryKey"
(Erro em tempo de execução 3251.
Operação não suportada para este tipo de objeto)

Pesquisei porem não consegui resolver.

Utilizo o código para controle de estoque (pesquisado e encontrado aqui no fórum).



Private Sub btn_Atualizar_Click()
If IsNull(Me.IdEntrada.Value) Or Me.IdEntrada.Value = "" Then
  MsgBox "Nenhuma movimentação de estoque para atualizar...", vbCritical, "Atenção"

  Exit Sub
   Else
'Informa mensagem de Ordem
If MsgBox("Você deseja atualizar o estoque?", vbQuestion + vbYesNo, "Confirme") = vbYes Then
'Devol.Value = True

'''''''''Atualização - baixa no estoque dos produtos vendidos''''''''''''''''''''''''

DoCmd.RunCommand acCmdSaveRecord

Dim wk As DAO.Workspace
Dim db As DAO.Database
Dim rstEstoque As DAO.Recordset
Dim rstSubFrm As DAO.Recordset
Set wk = DBEngine.Workspaces(0)
Set db = CurrentDb
Set rstEstoque = db.OpenRecordset("tbl_Produto")
Set rstSubFrm = Me.frm_EntradaDetalhe.Form.RecordsetClone
'Informa qual indice será utilzado pelo metodo seek no recordset de Estoque
rstEstoque.Index = "PrimaryKey"
'Posiciona o ponteiro do recordset do subfrm no primeiro registro
rstSubFrm.MoveFirst
'Inicia um loop no recordset do subfrm
Do While Not rstSubFrm.EOF
'Inicia a busca no recordset estoque usando como argumento de busca o conteudo do campo CodPeca do subfrm
rstEstoque.Seek "=", rstSubFrm!IdProd
'Se idêntico
If rstEstoque.NoMatch = False Then
rstEstoque.Edit 'Coloca o recordset em modo de edicao
rstEstoque("Estoque") = rstEstoque("Estoque") + rstSubFrm("QuantEntrada")
rstEstoque.Update 'Grava a alteracao efetuada!
End If
'avanca para o proximo registro do subfrm
rstSubFrm.MoveNext
Loop
'Encerra as variaveis
rstSubFrm.Close
rstEstoque.Close
db.Close
wk.Close
'Informa que foi dada baixa no estoque e imprime cupom de venda
MsgBox "Atualizando Estoque. ", vbInformation, "Atualizado com sucesso!!!"
Me.btn_novo_forn.Enabled = True
Me.btn_novo_forn.SetFocus
End If
End If

Substitua o método seek pelo find.

Boa noite cleverson

Eu não sei fazer esta alteração, pode me ajudar?

Por gentileza, pode me ajudar?

Preciso resolver, o projeot esta parado.

Bom dia, com a tua permissão Cleverson

rstEstoque.Find"=", rstSubFrm!IdProd

Bom dia Silvio

Vou testar e retorno

Fiz a alteração mas da erro na linha.

rstEstoque.Find"=", rstSubFrm!IdProd

Retire as aspas duplas

Ola a todos;

Você não consegue usar o metodo direto .Index = "PrimaryKey" em tabelas vinculadas, porque o access usa o dbOpenTable.
Tem de usar o metodo TableDefs com coneção á tabela vinculada, para poder usar o .Index = "PrimaryKey".

Teste por favor;

Código:

Private Sub btn_Atualizar_Click()
If IsNull(Me.IdEntrada.Value) Or Me.IdEntrada.Value = "" Then
MsgBox "Nenhuma movimentação de estoque para atualizar...", vbCritical, "Atenção"

Exit Sub
Else
'Informa mensagem de Ordem
If MsgBox("Você deseja atualizar o estoque?", vbQuestion + vbYesNo, "Confirme") = vbYes Then
'Devol.Value = True

'''''''''Atualização - baixa no estoque dos produtos vendidos''''''''''''''''''''''''

DoCmd.RunCommand acCmdSaveRecord

Dim wk As DAO.Workspace
Dim db As DAO.Database
Dim rstEstoque As DAO.Recordset
Dim rstSubFrm As DAO.Recordset
Set wk = DBEngine.Workspaces(0)
Dim stTabela$
stTabela = "tbl_Produto"

'não pode usar o metodo .Index = "PrimaryKey" em tabelas vinculadas, porque o access usa o dbOpenTable
'tem de usar o metodo TableDefs á tabela vinculada, para poder usar o .Index = "PrimaryKey"
Set db = OpenDatabase(Mid(DBEngine(0)(0).TableDefs(stTabela).Connect, 11))
Set rstEstoque = db.OpenRecordset(stTabela)

Set rstSubFrm = Me.frm_EntradaDetalhe.Form.RecordsetClone
'Informa qual indice será utilzado pelo metodo seek no recordset de Estoque
rstEstoque.Index = "PrimaryKey"
'Posiciona o ponteiro do recordset do subfrm no primeiro registro
rstSubFrm.MoveFirst
'Inicia um loop no recordset do subfrm
Do While Not rstSubFrm.EOF
'Inicia a busca no recordset estoque usando como argumento de busca o conteudo do campo CodPeca do subfrm
rstEstoque.Seek "=", rstSubFrm!IdProd
'Se idêntico
If rstEstoque.NoMatch = False Then
rstEstoque.Edit 'Coloca o recordset em modo de edicao
rstEstoque("Estoque") = rstEstoque("Estoque") + rstSubFrm("QuantEntrada")
rstEstoque.Update 'Grava a alteracao efetuada!
End If
'avanca para o proximo registro do subfrm
rstSubFrm.MoveNext
Loop
'Encerra as variaveis
rstSubFrm.Close
rstEstoque.Close
db.Close
wk.Close
'Informa que foi dada baixa no estoque e imprime cupom de venda
MsgBox "Atualizando Estoque. ", vbInformation, "Atualizado com sucesso!!!"
Me.btn_novo_forn.Enabled = True
Me.btn_novo_forn.SetFocus
End If
End If
End Sub


Bom dia JPaulo.

Vou testar e ja retorno

Funcionou, deu entrada correto no saldo do estoque.

Muito Obrigado Cleverson, Silvio e claro a você Jpaulo.

Alias tenho uma complementação pode ser neste post ou abrir outro se for este a duvida esta abaixo

Jpaulo penso em juntar dois codigos, o de salvar juntamente com este no botão salvar.

Onde ao clicar pede para salvar ou não se sim dispara o codigo da atualização e salva também os outros dados

É um formulário (Fornecedor, data emissão, entrada e nota fiscal

e um subformulario com os dados do produto.

é possivel.


Dim X As Integer
If Me.salvar.Value = -1 Then
MsgBox "Este lançamento já foi salvo!", vbExclamation, "Atenção"
Else
If IsNull(Me.IdProduto.Value) Or Me.IdProduto.Value = "" Then
MsgBox "Nenhum registro novo ou alterado para salvar...", vbCritical, "Atenção"
Else
Me.salvar.Value = -1

If (Me.Dirty = True) Then
X = MsgBox("Salvar registro no sistema ?", vbYesNo + vbInformation, "Confirmação")
DoCmd.GoToRecord , "", acNewRec
If X = vbNo Then
RunCommand acCmdSaveRecord
'Me.Ordem_Serviço.SetFocus
Exit Sub
End If
End If
End If
End If

Fico feliz por ter funcionado.

Essa ultima parte não entendi direito.

Juntar os dois códigos, o de atualizar, este que você fez, com o de salvar o que postei.

no botão salvar e quando clicar pede pra salvar e se sim dispara os dois codigos s atualiza e salva os registros.

Amigão teria de alterar de Private para Public o botão de atualizar o Estoque;

Public Sub btn_Atualizar_Click()

Qualquer coisa assim;

Código:

Private Sub SeuBotaoSalvar_Click()
    If Me.salvar.Value = True Then
        MsgBox "Este lançamento já foi salvo!", vbExclamation, "Atenção"
        Exit Sub
    End If

    If IsNull(Me.IdProduto.Value) Or Me.IdProduto.Value = "" Then
        MsgBox "Nenhum registro novo ou alterado para salvar...", vbCritical, "Atenção"
        Exit Sub
    End If

    If Me.Dirty = True Then
            If MsgBox("Salvar registro no sistema ?", vbYesNo + vbInformation, "Confirmação") = vbYes Then
            Me.salvar.Value = True
            Call btn_Atualizar_Click
            RunCommand acCmdSaveRecord
            DoCmd.GoToRecord , "", acNewRec
        Else
            Exit Sub
        End If
    End If
End Sub

vou testar e retorno

esta dando erro nesta linha "IdProduto" correto é idProd já substitui

If IsNull(Me.IdProd.Value) Or Me.IdProd.Value = "" Then

Já substituiu e está a funcionar ou ainda não ?

Acessar o banco com a tecla shift,  modo estrutura o form Entrada da mensagem erro de compilação em modulo oculto

e acessar com login teclando em salvar não acontece nada.

Segue uma parte do banco> usuario admin  senha apdf125 e senha do vba apdf3553

https://www.dropbox.com/preview/Estoque%20-%20Instalado.rar

Esse link não funciona.

Vou postar novamente

Segue uma parte do banco> usuário admin senha apdf125 e senha do vba apdf3553

http://ge.tt/3lKXNRm2

O botão salvar não estava a funcionar porque o Access não deteta o Dirty no SubForm, devido a você quando pressiona o botão no form, o foco saí do subform e já fica gravado.

Para resolver esse dilema, faça o seguinte;

Num modulo qualquer, no inicio declare esta variavel:

Código:

Public intDirty As Boolean

No botão salvar, faça assim para teste;

Código:

Private Sub btn_novo_forn_Click()
If Me.salvar.Value = True Then
        MsgBox "Este lançamento já foi salvo!", vbExclamation, "Atenção"
        Exit Sub
    End If

If intDirty = True Then
            If MsgBox("Salvar registro no sistema ?", vbYesNo + vbInformation, "Confirmação") = vbYes Then
            Me.salvar.Value = True
            Call btn_Atualizar_Click
            intDirty = False
        Else
            Exit Sub
        End If
    End If
End Sub

Fiz as alterações e continua sem funcionamento.

Clóvis amigão, o que é que não funciona ?

Detalhe por favor, para resolver-mos este tema.

Boa tarde JPaulo.

Eu fiz as alterações que sugeriu, refiz várias vezes e não estou tendo o resultado esperado.

Cópia do FrmEntrada esta na mensagem 22

Se puder testar ai mesmo lhe agradeço e muito.

Outra, sendo as tabelas vinculadas o código excluir também terá que mudar.

Faltou uma coisa importante na minha mensagem Nº23, desculpe ae;

No formulario "frm_EntradaDetalhe", no evento antes de atualizar tem de enviar o true para a variavel.

Código:


Private Sub Form_BeforeUpdate(Cancel As Integer)
    If Me.Dirty Then intDirty = True
End Sub


Continua sem nenhuma ação.

O nosso fuso horário é diferente.
Amanhã coloco aqui o seu exemplo, que aqui funfou.

ok
JPaulo o botão excluir poderia ver também.

Clóvis amigão, após explorar parte do seu banco verifico que a modelagem não é a mais correta e nem eu sou fã,
de se complicar o simples, veja só;

1º Você tem o campo Estoque e EstoqueMinimo, espalhado em quase todas as tabelas.
Esses dois campos só deveriam estar na tabela tbl_produto.

2º No sub form entradas, na origem deveria de ter a tabela tbl_produto, para saber sempre qual o estoque existente.

Código:

SELECT Tbl_EntradaDetalhe.IdEntradaDetalhe, Tbl_EntradaDetalhe.IdEntrada, Tbl_EntradaDetalhe.Idprod, Tbl_EntradaDetalhe.Unidade, Tbl_EntradaDetalhe.CUnit, Tbl_EntradaDetalhe.QuantEntrada, Tbl_EntradaDetalhe.salvar, Tbl_EntradaDetalhe.SubTotalE, tbl_produto.Estoque, tbl_produto.EstoqueMinimo, Tbl_EntradaDetalhe.Observação
FROM Tbl_EntradaDetalhe INNER JOIN tbl_produto ON Tbl_EntradaDetalhe.Idprod = tbl_produto.IdProd;


3º Nesse mesmo sub form entradas, após atualizar no campo "QuantEntrada", adicionar de imediato o estoque á tabela produto.

Código:

Private Sub QuantEntrada_AfterUpdate()
    CurrentDb.Execute "update tbl_Produto set Estoque=Estoque + " & Me.QuantEntrada.Value & "  where IdProd=" & cboProduto.Column(0)
    Me.Requery
End Sub

Desta forma, jamais irá necessitar de tanto trecho de código (completamente desnecessário), simplifica a coisa e o banco trabalha muito mais rápido.

Até poderá fazer a mensagem se quer salvar ou não, se não quiser é só fazer o roolbak assim;

Código:

Private Sub btn_novo_forn_Click()
If Me.salvar.Value = True Then
        MsgBox "Este lançamento já foi salvo!", vbExclamation, "Atenção"
        Exit Sub
    End If

If Me.Dirty = True Or intDirty = True Then
            If MsgBox("Deseja salvar registro no sistema ?", vbYesNo + vbInformation, "Confirmação") = vbYes Then
            Me.salvar.Value = True
            intDirty = False
            DoCmd.GoToRecord , "", acNewRec
            Exit Sub
        Else
'se não quer salvar, abre recordset á tabela detalheentrada
Dim rs As DAO.Recordset
Dim db As Database
Dim sSQL As String
Dim sValue As String

sSQL = "SELECT * FROM Tbl_EntradaDetalhe WHERE IdEntrada=" & Me.IdEntrada.Value
Set db = CurrentDb
Set rs = db.OpenRecordset(sSQL)

If rs.EOF Then Exit Sub
rs.MoveFirst
'atualiza o estoque na tabela produtos
Do Until rs.EOF
    CurrentDb.Execute "update tbl_produto set Estoque=Estoque - " & rs("QuantEntrada") & " where IdProd= " & rs("Idprod")
rs.MoveNext
Loop

rs.MoveFirst
'deleta o detalhe em primeiro
Do Until rs.EOF
    rs.Delete
rs.MoveNext
Loop

rs.Close
'deleta o cabeçalho
    CurrentDb.Execute "delete * from tbl_Entrada where IdEntrada=" & Me.IdEntrada.Value
    DoCmd.GoToRecord , "", acNewRec
            Exit Sub
        End If
    End If
End Sub

O mesmo se aplica ás saidas.

Bom dia JPaulo.

Vou rever conforme sua observação e retorno.

Para o ajudar a entender com maior rapidez;

Download

JPaulo,

Retirei os campos estoque e estoque mínimo que estavam em tabelas sem necessidade.

a origem da tbl_EntradaDetalhe também a fiz.

Mas o código salvar não funciona.

Ele nem ao menos dispara.

Amigão, um passo de cada vez.

Você deu entrada nos produtos do exemplo que anexei ?

Veja com atenção, porque eu  fiz aqui varias entradas e todas funcionaram.

Realmente esta funcionando mas assim:

Ha algumas alterações que me passou e as fiz e percebi no seu que esta diferente.

no form Entrada há instrução.

Private Sub Form_Load()
   intDirty = False
End Sub
não havia

e no subform EntradaDetalhe

Estava

If Me.Dirty Then intDirty = True

e no seu

If Me.Dirty = True Then intDirty = True


Bom muito obrigado JPaulo. Tenho outras duvidas mas irei abrir outro topico, a não ser que me ajude para no botão excluir do form uma instrução para excluir todo lançamento

Resolvido

Amigão;

O intDirty = False que está no Form_Load() foi adicionado por segurança, apenas para reiniciar a variavel, em nada tem a haver com o não funcionar.

O If Me.Dirty ou If Me.Dirty=True é a mesma coisa, apenas quando escrevo, escrevo mais completo (é uma mania minha).

Normalmente digita-se;

Código:

If Me.Dirty then Me.Dirty=False

Isto usa-se quando se está a usar uma tabela, e queremos fazer algum update.
Desta forma não dá erro, de tabela aberta em exclusivo.

Resolvido, resolvido está.

Obrigado pelo retorno o forum agradece.

Não tinha lido isto:
"a não ser que me ajude para no botão excluir do form uma instrução para excluir todo lançamento"

Se você responder NÃO ao salvar, já vai excluir todo o lançamento.

Me refiro depois de salvar. Ele sai do formulario e volta, localiza o lançamento e quer excluir.