CONSULTAR CAMPO PARA EXCLUSAO

USUARIO.EXCLUIDOS 21/08/2007 22:08:07
#231946
MODULO.BAS

Option Explicit

Global cn As ADODB.Connection
Global rs As ADODB.Recordset



Public Function Consultar(ByVal intCodigo As Integer) As Variant
    Set rs = CreateObject("ADODB.Recordset")

    With rs
    .Open "select * from TabClassificacaoProdutos where IdClassificacaoProd=" & intCodigo & "", cn, adOpenKeyset, adLockOptimistic
        If .RecordCount = 0 Then
            MsgBox "Código Inválido", vbExclamation, "Erro"
        Else
            FrmClassificacao.TxtCodigo = !IdClassificacaoProd
            FrmClassificacao.TxtClassificacao = IIf(IsNull(!Classificaao), Empty, !Classificaao)
            
        End If
        .Close
    End With
  
End Function

_______________________________

Dim tb As Recordset
Dim bd As Database

Private Sub CmdConsultar_Click()
 Dim intCodigo As Integer
    intCodigo = InputBox("Digite o Código", "Consulta")
    Consultar (intCodigo)
End Sub


Private Sub CmdGravar_Click()
tb.Index = "IdClassificacaoProd"
tb.Seek "=", TxtCodigo.TEXT
If tb.NoMatch = False Then
    'nome existente
    tb.Edit 'atualização
    tb("IdClassificacaoProd") = TxtCodigo.TEXT
    tb("Classificaao") = TxtClassificacao.TEXT
    
    tb.Update
Else 'nome não existe
    tb.AddNew 'adiciona um novo registro na tabela
    tb("IdClassificacaoProd") = TxtCodigo.TEXT
    tb("Classificaao") = TxtClassificacao.TEXT
    tb.Update 'atualiza o banco de dados
    'MsgBox "teste porra"
End If
    MsgBox "Cliente cadastrado", 64, "Gravado OK"
    TxtCodigo.TEXT = ""
    TxtClassificacao.TEXT = ""
    TxtCodigo.SetFocus
End Sub


Private Sub CmdGravar_GotFocus()
LblMensagem.Caption = ""
End Sub


Private Sub CmdSair_Click()
Unload Me
End Sub


Private Sub Form_Load()
Set bd = OpenDatabase(App.Path & "\banco.mdb", , "112233")
Set tb = bd.OpenRecordset("TabClassificacaoProdutos", dbOpenTable)

End Sub


Private Sub TxtClassificacao_GotFocus()
LblMensagem.Caption = "(E) Produtos Estocáveis e (N) Produtos não estocáveis"
End Sub


Private Sub TxtClassificacao_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then CmdGravar.SetFocus
End Sub


Private Sub TxtCodigo_GotFocus()
LblMensagem.Caption = "Identificador da Classificação do  Produto"
End Sub


Private Sub TxtCodigo_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtClassificacao.SetFocus
If Not IsNumeric(Chr(KeyAscii)) Then
KeyAscii = 0
End If
End Sub

________________________

Boa noite, galera
estou ficando louco, pois não consigo fazer uma simples consulta..

segue o codigo ....da um erro...

se alguém puder me ajudar a fazer essa pequena consulta...serei muito grato.

Desde já agradeço..

Uma boa semana a todos...
ZULLIM 21/08/2007 23:20:15
#231950
Qual consulta você deseja fazer?

Não entendi muito bem o seu código...
USUARIO.EXCLUIDOS 22/08/2007 00:27:57
#231954
Cara como não sei o erro que esta aperecendo,
tente alterar algumas coisas

ex...
coloque new na declaração
Global cn As new ADODB.Connection
Global rs As new ADODB.Recordset

verifique se ha erros de digitação tipo nao seria (classificacao)
IIf(IsNull(!Classificaao), Empty, !Classificaao)

IIf(IsNull(!Classificacao), Empty, !Classificacao)

 

[c]Public Function Consultar(ByVal intCodigo As Integer) As Variant
    Set rs = New ADODB.Recordset

    With rs
    .Open "select * from TabClassificacaoProdutos where IdClassificacaoProd=" & intCodigo & "", cn, adOpenKeyset, adLockOptimistic
        If .RecordCount = 0 Then
            MsgBox "Código Inválido", vbExclamation, "Erro"
        Else
            FrmClassificacao.TxtCodigo = !IdClassificacaoProd
            FrmClassificacao.TxtClassificacao = IIf(IsNull(!Classificacao), Empty, !Classificacao)
            
        End If
        .Close
    End With
  
End Function


[/c]

Att,

Marcelo Bressan
USUARIO.EXCLUIDOS 22/08/2007 06:31:30
#231959


Qual o erro q aparece e onde ele aparece?
USUARIO.EXCLUIDOS 22/08/2007 07:41:31
#231962
em qual linha da o erro cara?!
Tópico encerrado , respostas não são mais permitidas
Voltar