USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Fórum

  Visual Basic
Voltar
Autor Assunto:  localizar registo usando o acesso ADO
Aginaldo
JUIZ DE FORA
MG - BRASIL
ENUNCIADA !
Postada em 24/09/2005 13:28 hs            
BOA TARDE A TODOS
 
ALGEM SABE COMO FASSO PARA LOCALIZAR UM DETERMINADO ITEM, POR EXEMPLO
TENHO UM INDICE PELO CODIGO, E PRECISO LOCALIZAR UM CLIENTE, COMO FAZZO ISSO USANDO O ACESSO A DADOS  "ADO", POIS SEMPRE USEI O "DAO", NO DAO E O SEEK, MAS NO ADE O SEEK NAO FUNCIONOU.
 
Aginaldo
 
   
Donkey
Pontos: 2843 Pontos: 2843 Pontos: 2843 Pontos: 2843
PRESIDENTE PRUDENTE
SP - BRASIL
ENUNCIADA !
Postada em 24/09/2005 15:40 hs            
Já que esta migrando para ADO sugiro começar a usar SQL tambem, quando eu usava DAO tambem só fazia pesquisas via Seek, + com sql é tudo + facil, e vc economiza muitos codigos.
No caso seria algo do tipo, select * from tabela where codigo = 1
 
Iria pegar todos os campos da tabela cujo codigo seja igual a 1.
Vc pode incrementar o where, como algo do tipo:
Select * from tabela where estoque < 10
 
Pegaria todos os produtos cujo campo estoque seja menor que 10, com isso vc não teria que fazer + aquelas estruturas de repetição, nem aquele monte de If.
 
Acredito que no ADO não tenha seek, pq lembro que quando migrei para ADO já tive que começar a usar sql tambem....
T+
   
Mateus
AMADORA
PT - PORTUGAL
ENUNCIADA !
Postada em 24/09/2005 18:15 hs            
Se está começando a trabalhar com dados e ado, que tal um verdadeiro repositorio de código para o fazer?
 
Pois aí vai:
 

ADO - Exemplo de como trabalhar com Dados

 

Public Function ConexaoDados() As Connection

 

base = PstrCamDados & "mvdoctab.mdb"

Set dbDados = New ADODB.Connection

With dbDados

    .Provider = "Microsoft.Jet.OLEDB.4.0"

    .Properties("Data Source") = base

    .Properties("Jet OLEDB:Database Password") = "password"

    .Open

End With

 

End Function

 

Public Function MostrarTodos() As ADODB.Recordset

 

Set rstMovimentos = New ADODB.Recordset

 

strSql = "SELECT * FROM tMovimentos"

rstMovimentos.CursorLocation = adUseClient

rstMovimentos.Open strSql, dbDados, adOpenKeyset, adLockReadOnly, adCmdText

 

Set MostrarTodos = rstMovimentos

 

Set rstMovimentos = Nothing

 

End Function

 

 

Public Sub Inserir()

 

On Error Resume Next

   

strSql = "INSERT INTO tMovimentos (id_movimento,"

strSql = strSql & " codigo,mov_tipo,mov_tipo2,mov_data,ent_num_contr,"

strSql = strSql & " ent_num_ei,ent_num,mov_docref,tipo_pag,not_venda,"

strSql = strSql & " data,cod_util,transfer)VALUES('" & id & "',"

strSql = strSql & " " & cod & " ,'" & movt & "','" & movd & "','" & dat & "'," & entidnc & ","

strSql = strSql & " " & entidne & ", " & entid & ",'" & ref & "','" & tp & "','" & nv & "',"

strSql = strSql & " '" & dat & "','" & ut & "', '" & transf & "')"

 

dbDados.Execute strSql

 

   Select Case Err.Number

   Case 0:

     

      MsgBox "Registo incluído.", vbInformation, "Atenção"

   Case -2147217864

      MsgBox "Registo excluído por outro utilizador. As alterações feitas não serão salvas.", vbInformation, "Atenção"

   Case -2147467259

      MsgBox "Registo bloqueado por outro utilizador. O Registo não pode ser incluído. Tente mais tarde." & vbCr, vbExclamation, "Atenção"

   Case Else

      MsgBox "O Registo não pode ser incluído." + vbCrLf + Err.Description

   End Select

 

 

End Sub

 

 

 

 

Public Function ObterCodigo() As String

 

Dim strCod As String, intMaxCod As Integer

 

Set rstMovimentos = New ADODB.Recordset

 

rstMovimentos.CursorLocation = adUseClient

rstMovimentos.Open "SELECT max(id_movimento)from tMovimentos where mid(tmovimentos.id_movimento,1,4)= '" & inicio & "'", dbDados, adOpenKeyset, adLockReadOnly, adCmdText

 

If IsNull(rstMovimentos.Fields(0)) Then

   ant = inicio & "000000"

   ObterCodigo = ant + 1

Else

ant = rstMovimentos.Fields(0).Value

ObterCodigo = ant + 1

 

End If

 

Set rstMovimentos = Nothing

 

End Function

 

 

 

Public Sub Alterar()

 

 

On Error Resume Next

 

strSql = "UPDATE tMovimentos SET tMovimentos.mov_tipo='" & movt & "',"

strSql = strSql & "tMovimentos.mov_tipo2='" & movd & "',"

strSql = strSql & "tMovimentos.mov_data = '" & CVDate(dat) & "',"

strSql = strSql & "tMovimentos.ent_num_contr=" & entidnc & ",tMovimentos.ent_num_ei=" & entidne & ","

strSql = strSql & "tMovimentos.ent_num=" & entid & ",tMovimentos.mov_docref ='" & ref & "',"

strSql = strSql & "tMovimentos.tipo_pag='" & tp & "',tMovimentos.not_venda=" & nv & ","

strSql = strSql & "tMovimentos.data= '" & CVDate(datr) & "',"

strSql = strSql & "tMovimentos.cod_util='" & ut & "',"

strSql = strSql & "tMovimentos.transfer='" & transf & "' "

strSql = strSql & "WHERE tMovimentos.id_movimento= '" & id & "' and tMovimentos.codigo=" & cod & " "

 

dbDados.Execute strSql

 

   Select Case Err.Number

   Case 0

      MsgBox "Alteração concluída.", vbInformation, "Atenção"

   Case -2147217864

      MsgBox "Registo excluído por outro utilizador. As alterações feitas não serão salvas.", vbInformation, "Atenção"

   Case -2147467259

      MsgBox "Registo bloqueado por outro utilizador. As alterações não foram salvas. Tente mais tarde." & vbCr, vbExclamation, "Atenção"

   Case Else

      MsgBox "O Registo não pode ser alterado." + vbCrLf + Err.Description

   End Select

 

 

End Sub

 

 

Public Function Excluir()

 

strSql = "DELETE FROM tMovimentos "

strSql = strSql & "WHERE tMOVIMENTOS.id_movimento= '" & id & "' and tMovimentos.codigo=" & cod & ""

 

On Error Resume Next

dbDados.Execute strSql

Select Case Err.Number

  Case 0:

     MsgBox "Registo Excluído.", vbInformation, "Atenção"

  Case -2147217864

     MsgBox "Registo já excluído por outro utilizador.", vbInformation, "Atenção"

  Case -2147467259

     MsgBox "Registo bloqueado por outro utilizador. Exclusão não permitida. Tente mais tarde." & vbCr, vbExclamation, "Atenção"

  Case Else

     MsgBox "O Registo não pode ser excluído." + vbCrLf + Err.Description, "Atenção"

  End Select

 

End Function

 

 

Public Function ConfirmarRegisto(ByVal strIdentificativo As String, ByVal strCodigo As Long) As Boolean

 

 

Set rstMovimentos = New ADODB.Recordset

 

strSql = "SELECT id_movimento, Codigo FROM tMovimentos"

strSql = strSql & " WHERE tMOVIMENTOS.id_movimento ='" & strIdentificativo & "'"

strSql = strSql & " and tMOVIMENTOS.Codigo = " & strCodigo & ""

rstMovimentos.CursorLocation = adUseClient

rstMovimentos.Open strSql, dbDados, adOpenKeyset, adLockReadOnly, adCmdText

 

If Not rstMovimentos.EOF Then

 ConfirmarRegisto = True

Else

 ConfirmarRegisto = False

End If

 

rstMovimentos.Close

 

Set rstMovimentos = Nothing

 

End Function

 

 

Public Function Consultar(ByVal strSql As String) As ADODB.Recordset

 

Set rstMovimentos = New ADODB.Recordset

   

If strSql = Null Then

   strSql = ""

End If

   

rstMovimentos.CursorLocation = adUseClient

rstMovimentos.Open strSql, dbDados, adOpenKeyset, adLockReadOnly, adCmdText

 

Set Consultar = rstMovimentos

 

Set rstMovimentos = Nothing

 

End Function

 

 

Public Function MostrarTodosDetalhe() As Recordset

 

Set rstMovimentos = New ADODB.Recordset

 

strSqlD = "SELECT * FROM tMovimentosdet"

rstMovimentos.CursorLocation = adUseClient

rstMovimentos.Open strSqlD, dbDados, adOpenKeyset, adLockReadOnly, adCmdText

 

Set MostrarTodosDetalhe = rstMovimentos

 

Set rstMovimentos = Nothing

 

End Function

 

 

 

 

 

Public Sub ExcluirTodosDetalhe()

 

strSqlD = "DELETE FROM tMovimentosdet "

strSqlD = strSqlD & "WHERE tMOVIMENTOSdet.id_movimento= '" & id & "' and tMovimentosdet.codigo=" & cod & ""

 

On Error Resume Next

dbDados.Execute strSqlD

Select Case Err.Number

  Case 0:

     MsgBox "Registo Excluído.", vbInformation, "Atenção"

  Case -2147217864

     MsgBox "Registo já excluído por outro utilizador.", vbInformation, "Atenção"

  Case -2147467259

     MsgBox "Registo bloqueado por outro utilizador. Exclusão não permitida. Tente mais tarde." & vbCr, vbExclamation, "Atenção"

  Case Else

     MsgBox "O Registo não pode ser excluído." + vbCrLf + Err.Description, "Atenção"

  End Select

 

 

End Sub

 

 

Public Sub ExcluirRegistoDetalhe()

 

 

On Error Resume Next

   

strSqlD = "DELETE FROM TMovimentosDet WHERE codigo = " & cod & " AND id_movimento = '" & id & "'"

 

dbDados.Execute strSqlD

 

     Select Case Err.Number

     Case 0:

       

     Case -2147217864

        MsgBox "Registo já excluído por outro utilizador.", vbInformation, "Atenção"

     Case -2147467259

        MsgBox "Registo bloqueado por outro utilizador. Exclusão não permitida. Tente mais tarde." & vbCr, vbExclamation, "Atenção"

     Case Else

        MsgBox "O registo não pode ser excluído." + vbCrLf + Err.Description, "Atenção"

     End Select

 

 

End Sub

 

 

 

Public Sub InserirDetalhe()

 

On Error Resume Next

   

strSqlD = "INSERT INTO TMovimentosDet (mov_tipo, art_codig, serie_id, serie_ini, serie_fim, codigo, id_movimento, serie_contad,"

strSqlD = strSqlD & "art_quant, art_valunit, valor ) VALUES ("

strSqlD = strSqlD & "'" & movt & "', '" & art & "','" & ser

strSqlD = strSqlD & "', " & ini & ", " & fim & ", " & cod

strSqlD = strSqlD & " , '" & id & "', " & contad

strSqlD = strSqlD & ", " & quant & ", " & valunit & ", " & val & ")"

dbDados.Execute strSqlD

 

   Select Case Err.Number

  

   Case 0

      Exit Sub

   Case -2147217864

      MsgBox "Registo excluído por outro utilizador. As alterações feitas não serão salvas.", vbInformation, "Atenção"

   Case -2147467259

      MsgBox "Registo bloqueado por outro utilizador. O registo não pode ser incluído. Tente mais tarde." & vbCr, vbExclamation, "Atenção"

   Case Else

      MsgBox "O registo não pode ser incluído." + vbCrLf + Err.Description

   End Select

 

 

End Sub

 

 

 

Public Function ConsultarDetalhe(ByVal strSqlD As String) As Recordset

 

Set rstMovimentos = New ADODB.Recordset

   

If strSql = Null Then

   strSql = ""

End If

   

 

rstMovimentos.CursorLocation = adUseClient

rstMovimentos.Open strSql & strSql, dbDados, adOpenKeyset, adLockReadOnly, adCmdText

 

Set ConsultarDetalhe = rstMovimentos

 

Set rstMovimentos = Nothing

 

End Function

 

 

 


João Mateus

Se precisar de ajuda extra, visite:

http://joaomateus.planetaclix.pt

   
Página(s): 1/1    


Seu Nome:

Seu eMail:

ALTERAR PARA MODO HTML
Mensagem:

[:)] = 
[:P] = 
[:(] = 
[;)] = 

HTML DESLIGADO

     
 VOLTAR

  



CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página