[Resolvido]Inclusão no subformulário com base no status do produto

Boa tarde!

Tenho o código abaixo que verifica se o produto está cadastrado na "tblProdutos" antes de incluí-lo no subform.

Código:

  If DCount("*", "tblProdutos", "codigoProduto = """ & Me!txtLeituraSKU.Value & """") = 0 Then
      MsgBox "O código " & [txtLeituraSKU] & " não consta na base de dados.", vbCritical, "Erro"
      Me.txtLeituraSKU = ""
      Exit Sub
  End If

Alguém poderia me ajudar com um código que verificasse também se o status do produto é "Ativo" antes de incluir ele no subform? Pois o sistema só deve aceitar a inclusão no subform de produtos que estejam cadastrados e com status de "Ativo".

Obrigado!

boa noite!

tenta assim.

Código:

Dim seq As String, k


'\\\ Busca produto na tabela de produto
seq = "[Produto] & '|' & [Ativo]"
seq = Nz(DLookup(seq, "tblProdutos", "codigoProduto = " & Me!txtLeituraSKU.Value))
  k = Split(seq, "|")
  
  
    '\\ Se a busca na tabela não encontrou nenhum registro.
    If seq = "" Then
  
        MsgBox "Produto não Cadastrado!", vbCritical, "Produto não encontrado"
        
        Me.txtLeituraSKU.SetFocus
        
        Exit Sub
  
        End if


       '\\ Se encontrou o produto cadastrado mas o produto está inativo.
        if k(1) = -1 Then

        MsgBox "Produto: " & k(0) & " está inativo!", vbCritical, "Produto inativo"
        
        Me.txtLeituraSKU.SetFocus
        
        Exit Sub
  
    End If

 '\\ Se nenhuma das condições acima for verdadeira então deixa prosseguir o cadastro.


Oi Marcos, boa noite e obrigado pela atenção!

Então, eu queria algo mais simplificado, pois o código já é bem complexo. Olha...

Código:

Private Sub txtLeituraSKU_Change()

  If Len(Nz(Me.txtLeituraSKU.Text)) = 5 Then

      Me.txtIdRepresentante.SetFocus
      Me.txtCodProd = Right(txtLeituraSKU, 5)
      Me.txtLeituraSKU.SetFocus

      If DCount("*", "tblProdutos", "codigoProduto = """ & Me!txtLeituraSKU.Value & """") = 0 Then
        MsgBox "O código " & [txtLeituraSKU] & " não consta na base de dados.", vbCritical, "Erro"
        Me.txtLeituraSKU = ""
        Exit Sub
'      If DCount("*", "tblProdutos", statusProduto = """ & Me!txtLeituraSKU.Value & """") <> "Ativo" Then
'        MsgBox "O produto selecionado não está ativo no sistema.", vbExclamation, "Aviso"
'        Me.txtLeituraSKU = ""
'        Exit Sub
      Else
     
        Dim objBD As DAO.Database

        If Nz(Me!txtLeituraSKU.Value) = "" Then Exit Sub
 
        Set objBD = CurrentDb

        Call objBD.Execute("update tblDetalhesPedido " & _
                            "set qtdeSaida = qtdeSaida + 1 " & _
                            "where idPedido = " & Me!txtIdPedido.Value & " and codigoProduto = """ & Me!txtCodProd.Value & """;")

        If objBD.RecordsAffected = 0 Then
            Call objBD.Execute("insert into tblDetalhesPedido (idPedido, codigoProduto) " & _
                              "values(" & Me!txtIdPedido.Value & ", """ & Me!txtCodProd.Value & """);")
        End If

        Set objBD = Nothing

        Me!txtLeituraSKU.Value = Null
        Me!subformDetalhesPedido.Requery
        Me!txtIdRepresentante.SetFocus
        Me!txtLeituraSKU.SetFocus
      End If

  End If

End Sub

Nas linhas onde marquei como comentário foi a forma que tentei para validar o status, mas não funfou. Se verificar acima dela, está o código que postei na 1ª msg. Nesse caso, teria algum código mais simples que poderia substituir as linhas que deixei marcada como comentário?

Então fera, veja alteração com comentário:

Código:

Private Sub txtLeituraSKU_Change()

  If Len(Nz(Me.txtLeituraSKU.Text)) = 5 Then

      Me.txtIdRepresentante.SetFocus
      Me.txtCodProd = Right(txtLeituraSKU, 5)
      Me.txtLeituraSKU.SetFocus

      If DCount("*", "tblProdutos", "codigoProduto = """ & Me!txtLeituraSKU.Value & """") = 0 Then
        MsgBox "O código " & [txtLeituraSKU] & " não consta na base de dados.", vbCritical, "Erro"
        Me.txtLeituraSKU = ""
        Exit Sub

      'O campo "statusProduto" armazena opções do tipo >>> "ativo" ou "inativo" do tipo texto certo?? suponho que sim ou não?
      If Dlookup("[statusProduto]", "tblProdutos", "codigoProduto = """ & Me!txtLeituraSKU.Value & """") <> "Ativo" Then
        MsgBox "O produto selecionado não está ativo no sistema.", vbExclamation, "Aviso"
        Me.txtLeituraSKU = ""

        Exit Sub

      Else
     
        Dim objBD As DAO.Database

        If Nz(Me!txtLeituraSKU.Value) = "" Then Exit Sub
 
        Set objBD = CurrentDb

        Call objBD.Execute("update tblDetalhesPedido " & _
                            "set qtdeSaida = qtdeSaida + 1 " & _
                            "where idPedido = " & Me!txtIdPedido.Value & " and codigoProduto = """ & Me!txtCodProd.Value & """;")


        If objBD.RecordsAffected = 0 Then
            Call objBD.Execute("insert into tblDetalhesPedido (idPedido, codigoProduto) " & _
                              "values(" & Me!txtIdPedido.Value & ", """ & Me!txtCodProd.Value & """);")
        End If

        Set objBD = Nothing

        Me!txtLeituraSKU.Value = Null
        Me!subformDetalhesPedido.Requery
        Me!txtIdRepresentante.SetFocus
        Me!txtLeituraSKU.SetFocus

      End If

  End If

End Sub


Teu código tem muitos IFs, melhorar a logica vai simplificar e reduzir o script

Cara, era exatamente o que eu precisava!!

E respondendo sua pergunta.. Sim, o status pode ser Ativo ou Inativo. Sobre os muitos If's, meu conhecimento ainda é limitado e estou aprendendo aos poucos rsrs. Enquanto isso vou fazendo como posso seguindo o "arroz com feijão" hehe. Um dia chego lá...

Só para esclarecer nesse caso, o bloco tem muitos If's pq realmente são muitos critérios tipo.. ao digitar o código, o sistema verifica se o produto está ativo e tb se já consta no subform e então:

1. Se tiver com status Ativo e constar na lista do subform, ele soma +1 na qtde;
2. Se tiver com status Ativo e não constar na lista do subform, ele insere;
3. Se tiver com status Inativo, ele emite a msg de aviso e encerra o bloco;
4. Se o produto não tiver cadastrado, ele tb emite a msg de erro e encerra o bloco.

Obrigado pela ajuda, deu certinho aqui! Abraço!