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

 

  Fórum

  Visual Basic
Voltar
Autor Assunto:  Duvida ADO
Everest
BARRA MANSA
RJ - BRASIL
ENUNCIADA !
Postada em 26/06/2006 18:09 hs            
Como eu faço para navegar nos registros usando ADO? com DAO eu lembro que é assim Ex: if not rst.eof then rst.movenext
 
como eu faço para navegar nos registros e saber se chegou ao fim?
 
abs,
 
 
   
Sandro
não registrado
ENUNCIADA !
Postada em 26/06/2006 22:02 hs   
Olá,
 
Da mesma forma! Todos os métodos de navegação permanecem: MoveNext, MovePrevious, MoveMin, MoveMax, EOF e BOF. Não há mistério nisso, eu mesmo uso a DAO e a ADO em diversos projetos.
 
um abraço,
Sandro.
   
LAURÃO
TUCURUÍ
PA - BRASIL
ENUNCIADA !
Postada em 27/06/2006 15:44 hs            
Olá, Veja alguns exemplos (esperonão ter exagerado)
Boa Sorte

Public Sub BtnFisrtReg(MeuRecordSet As Object)
   On Error GoTo GoMinError

MeuRecordSet.MoveMin

mbDataChanged = False

Exit Sub

GoMinError:
MsgBox err.Description

End Sub
Public Sub BtnFisrtReg1(MeuRecordSet As Object)
On Error GoTo GoPrevError

  If Not MeuRecordSet.BOF Then MeuRecordSet.MovePrevious
  If MeuRecordSet.BOF And MeuRecordSet.RecordCount > 0 Then
    Beep
        'moved off the end so go back
    MeuRecordSet.MoveMin
    MsgBox "Calma, chegamos ao início do arquivo."
  End If
  'show the current record
  mbDataChanged = False
  Exit Sub

GoPrevError:
  MsgBox err.Descriptionn

End Sub
Public Sub BtnAnterReg(MeuRecordSet As Object)
On Error GoTo GoPrevError

  If Not MeuRecordSet.BOF Then MeuRecordSet.MovePrevious
  If MeuRecordSet.BOF And MeuRecordSet.RecordCount > 0 Then
    Beep
        'moved off the end so go back
    MeuRecordSet.MoveMin
    MsgBox "Calma, chegamos ao início do arquivo."
  End If
  'show the current record
  mbDataChanged = False
  Exit Sub

GoPrevError:
  MsgBox err.Description
End Sub
Public Sub BtnProxReg(MeuRecordSet As Object)
  On Error GoTo GoNextError

  If Not MeuRecordSet.EOF Then MeuRecordSet.MoveNext
  If MeuRecordSet.EOF And MeuRecordSet.RecordCount > 0 Then
    Beep
     'moved off the end so go back
    MeuRecordSet.MoveMax
    MsgBox "Calma, chegamos ao fim do arquivo."
    
  End If
  'show the current record
  mbDataChanged = False
  Exit Sub
GoNextError: RotinaTratErros
  End Sub
Public Sub BtnUltmReg(MeuRecordSet As Object)
On Error GoTo MaxErr

  MeuRecordSet.MoveMax
  mbDataChanged = False
  
  Exit Sub
MaxErr:
  MsgBox err.Description
End Sub
Public Sub BtnUpdate(MeuRecordSet As Object)
On Error GoTo UpdateErr

  MeuRecordSet.UpdateBatch adAffectAll
  MsgBox "Atualização efetuada com Sucesso!!!"
  
  If mbAddNewFlag Then
    MeuRecordSet.MoveMax              'move to the new record
  End If

  mbEditFlag = False
  mbAddNewFlag = False
  
  mbDataChanged = False

  Exit Sub
UpdateErr:
  MsgBox err.Description
End Sub
Public Sub BtnCancel(MeuRecordSet As Object)
  On Error GoTo erro

  mbEditFlag = False
  mbAddNewFlag = False
  MeuRecordSet.CancelUpdate
  If mvBookMark > 0 Then
    MeuRecordSet.Bookmark = mvBookMark
  Else
    MeuRecordSet.MoveMin
  End If
  mbDataChanged = False
erro:   RotinaTratErros

End Sub
Public Sub BtnEdit(MinhaLabel As Control)
  On Error GoTo EditErr
  MinhaLabel.Caption = "Edit record"
  mbEditFlag = True
  Exit Sub
EditErr:
  MsgBox err.Description
End Sub
Public Sub btnRefresh(MeuRecordSet As Object)
  'This is only needed for multi user apps
  On Error GoTo RefreshErr
  MeuRecordSet.Requery
  
  Exit Sub
RefreshErr:
  MsgBox err.Description
End Sub
Public Sub BtnDelete(MeuRecordSet As Object, TxtCampoChave As String, TxtCampoMsgBox As String)
On Error GoTo erro
If TxtCampoChave = "" Then
MsgBox "Não existe Dados Armazenados para Deleção!!!"
Else
  If (MsgBox("Deseja excluir o Registro:  " & TxtCampoMsgBox & "  ?  ", vbYesNo, "Exclusão de Registros")) = vbYes Then
    MeuRecordSet.Delete
    MeuRecordSet.MovePrevious
    If MeuRecordSet.BOF Then
      MsgBox "Voce chegou no inicio do arquivo ! "
      Exit Sub
    Else
   End If
  End If
End If
erro:   RotinaTratErros

End Sub
Public Sub BtnAdd(MeuRecordSet As Object, MinhaLabel As Control, txtBoxIni As Control)
  On Error GoTo AddErr
  With MeuRecordSet
    If Not (.BOF And .EOF) Then
      mvBookMark = .Bookmark
    Else
    
    End If
    .AddNew
    MinhaLabel.Caption = "Add record"
    mbAddNewFlag = True
      End With
txtBoxIni.SetFocus
  Exit Sub
AddErr:
  MsgBox err.Description
End Sub
Public Sub BtnLocaliza(MeuRecordSet As Object, NomCampoTab As String, MeuLink As String, ImptBoxYN As Boolean, NomTitImputBox As String)
   On Error GoTo erro:
   Dim Resposta As String
   Dim Marca As Variant
   Dim Sim As String
   Dim Não As String
   If ImptBoxYN = True Then
        Resposta = InputBox("Informe o codigo " & NomTitImputBox & " localizar ", "Localizar", Resposta, 1800, 3000)
   Else
        Resposta = MeuLink
   End If
  
   If Resposta <> "" Then
      Marca = MeuRecordSet.Bookmark
   Else
      Exit Sub

   End If
   MeuRecordSet.Find NomCampoTab & "=" & Resposta
   If MeuRecordSet.EOF Then
       MsgBox "Não encontrei o codigo " & Resposta
       MeuRecordSet.Bookmark = Marca
       Exit Sub
erro:       RotinaTratErros
  
   End If
  

End Sub
Public Sub RtnLocaliza(MeuRecordSet As Object, NomCampoTab As String, MinhaStrloc As String)
'Rotina usada conjuntamento com o Form Localizar, ao abrir forms Cadas
   On Error GoTo erro
   Dim Marca As Variant
  
   If MinhaStrloc <> "" Then
      Marca = MeuRecordSet.Bookmark
   Else
      Exit Sub
   End If
   BtnFisrtReg MeuRecordSet
   MeuRecordSet.Find NomCampoTab & "=" & MinhaStrloc
   If MeuRecordSet.EOF Then
            MsgBox "Não encontrei o codigo " & MinhaStrloc
            MeuRecordSet.Bookmark = Marca
        
        Else
            Exit Sub
erro:    RotinaTratErros
   End If

End Sub
Public Sub RtnLocalizaComSub(MeuRecordSet As Object, NomCampoTab As String, MinhaStrloc As String, SubRotinaYN As Boolean, MinhaSub As String)
'Rotina usada conjuntamento com o Form Localizar, ao abrir forms Cadas
   On Error GoTo erro
   Dim Marca As Variant
  
   If MinhaStrloc <> "" Then
      Marca = MeuRecordSet.Bookmark
   Else
      Exit Sub
   End If
   BtnFisrtReg MeuRecordSet
   MeuRecordSet.Find NomCampoTab & "=" & MinhaStrloc
   If MeuRecordSet.EOF Then
        If SubRotinaYN = False Then
            MsgBox "Não encontrei o codigo " & MinhaStrloc
            MeuRecordSet.Bookmark = Marca
        ElseIf SubRotinaYN = True Then
            
        Else
            Exit Sub
erro:    RotinaTratErros
        
        End If
   End If


End Sub
Public Sub lblStatusClick(MinhaLabel As Control, MeuRecordSet As Object)
On Error GoTo erro
'This will display the current record position for this recordset
If CStr(MeuRecordSet.AbsolutePosition) = -1 Then
MinhaLabel.Caption = "Not Data"
Else
  MinhaLabel.Caption = "Reg.: " & CStr(MeuRecordSet.AbsolutePosition) & "/" & MeuRecordSet.RecordCount
End If
erro: RotinaTratErros

End Sub
Public Sub BtnDeletarComExecute(NomTab As String, NomCampoWhere As String, MeuLink As String, CampoMSGBox As String, MeuRecordSet As Object, MsgBYN As Boolean)

On Error GoTo erro

If MeuLink = "" Then
            MsgBox "Não existe Dados Armazenados para Deleção!!!"
Else
        If (MsgBox("Deseja excluir o Registro:  " & CampoMSGBox & "  ?  ", vbYesNo, "Exclusão de Registros")) = vbYes Then
            If MsgBYN = True Then
                sql1 = "DELETE" & " " & "*" & " " & "FROM" & " " & NomTab & " " & "WHERE" & " " & NomCampoWhere & " " & "="
                Sql = sql1 & MeuLink
                db.Execute Sql
                MsgBox "O Registro: " & CampoMSGBox & " - Foi Excluido com Sucesso !!!"
                MeuRecordSet.MovePrevious
                btnRefresh MeuRecordSet
            ElseIf MsgBYN = False Then
                sql1 = "DELETE" & " " & "*" & " " & "FROM" & " " & NomTab & " " & "WHERE" & " " & NomCampoWhere & " " & "="
                Sql = sql1 & MeuLink
                db.Execute Sql
                MeuRecordSet.MovePrevious
                btnRefresh MeuRecordSet
            End If
            
        Else
            If MeuRecordSet.BOF Then
            MsgBox "Você chegou ao início do arquivo"
            Exit Sub
            End If
        End If
End If
erro:   RotinaTratErros
End Sub
Public Sub BtnDeletarComExecuteSemMsgBox(NomTab As String, NomCampoWhere As String, MeuLink As String, MeuRecordSet As Object)
On Error GoTo erro
        If MeuLink = "" Then
            MsgBox "Não existe Dados Armazenados para Deleção!!!"

        Else
               sql1 = "DELETE" & " " & "*" & " " & "FROM" & " " & NomTab & " " & "WHERE" & " " & NomCampoWhere & " " & "="
                Sql = sql1 & MeuLink
                db.Execute Sql
                MeuRecordSet.MovePrevious
                btnRefresh MeuRecordSet
            
        If MeuRecordSet.BOF Then
      MsgBox "Voce chegou no inicio do arquivo ! "
      Exit Sub
erro:   RotinaTratErros
    
    Else
   End If
  End If
End Sub
Public Sub BtnAbrirFormDeOutroForm(Nomforme As Form, NomformOpen As Form)
StrLoc = Nomforme.Name
NomformOpen.Show
Unload Nomforme
End Sub

   
LAURÃO
TUCURUÍ
PA - BRASIL
Postada em 27/06/2006 15:44 hs            
Olá, Veja alguns exemplos (esperonão ter exagerado)
Boa Sorte

Public Sub BtnFisrtReg(MeuRecordSet As Object)
   On Error GoTo GoMinError

MeuRecordSet.MoveMin

mbDataChanged = False

Exit Sub

GoMinError:
MsgBox err.Description

End Sub
Public Sub BtnFisrtReg1(MeuRecordSet As Object)
On Error GoTo GoPrevError

  If Not MeuRecordSet.BOF Then MeuRecordSet.MovePrevious
  If MeuRecordSet.BOF And MeuRecordSet.RecordCount > 0 Then
    Beep
        'moved off the end so go back
    MeuRecordSet.MoveMin
    MsgBox "Calma, chegamos ao início do arquivo."
  End If
  'show the current record
  mbDataChanged = False
  Exit Sub

GoPrevError:
  MsgBox err.Descriptionn

End Sub
Public Sub BtnAnterReg(MeuRecordSet As Object)
On Error GoTo GoPrevError

  If Not MeuRecordSet.BOF Then MeuRecordSet.MovePrevious
  If MeuRecordSet.BOF And MeuRecordSet.RecordCount > 0 Then
    Beep
        'moved off the end so go back
    MeuRecordSet.MoveMin
    MsgBox "Calma, chegamos ao início do arquivo."
  End If
  'show the current record
  mbDataChanged = False
  Exit Sub

GoPrevError:
  MsgBox err.Description
End Sub
Public Sub BtnProxReg(MeuRecordSet As Object)
  On Error GoTo GoNextError

  If Not MeuRecordSet.EOF Then MeuRecordSet.MoveNext
  If MeuRecordSet.EOF And MeuRecordSet.RecordCount > 0 Then
    Beep
     'moved off the end so go back
    MeuRecordSet.MoveMax
    MsgBox "Calma, chegamos ao fim do arquivo."
    
  End If
  'show the current record
  mbDataChanged = False
  Exit Sub
GoNextError: RotinaTratErros
  End Sub
Public Sub BtnUltmReg(MeuRecordSet As Object)
On Error GoTo MaxErr

  MeuRecordSet.MoveMax
  mbDataChanged = False
  
  Exit Sub
MaxErr:
  MsgBox err.Description
End Sub
Public Sub BtnUpdate(MeuRecordSet As Object)
On Error GoTo UpdateErr

  MeuRecordSet.UpdateBatch adAffectAll
  MsgBox "Atualização efetuada com Sucesso!!!"
  
  If mbAddNewFlag Then
    MeuRecordSet.MoveMax              'move to the new record
  End If

  mbEditFlag = False
  mbAddNewFlag = False
  
  mbDataChanged = False

  Exit Sub
UpdateErr:
  MsgBox err.Description
End Sub
Public Sub BtnCancel(MeuRecordSet As Object)
  On Error GoTo erro

  mbEditFlag = False
  mbAddNewFlag = False
  MeuRecordSet.CancelUpdate
  If mvBookMark > 0 Then
    MeuRecordSet.Bookmark = mvBookMark
  Else
    MeuRecordSet.MoveMin
  End If
  mbDataChanged = False
erro:   RotinaTratErros

End Sub
Public Sub BtnEdit(MinhaLabel As Control)
  On Error GoTo EditErr
  MinhaLabel.Caption = "Edit record"
  mbEditFlag = True
  Exit Sub
EditErr:
  MsgBox err.Description
End Sub
Public Sub btnRefresh(MeuRecordSet As Object)
  'This is only needed for multi user apps
  On Error GoTo RefreshErr
  MeuRecordSet.Requery
  
  Exit Sub
RefreshErr:
  MsgBox err.Description
End Sub
Public Sub BtnDelete(MeuRecordSet As Object, TxtCampoChave As String, TxtCampoMsgBox As String)
On Error GoTo erro
If TxtCampoChave = "" Then
MsgBox "Não existe Dados Armazenados para Deleção!!!"
Else
  If (MsgBox("Deseja excluir o Registro:  " & TxtCampoMsgBox & "  ?  ", vbYesNo, "Exclusão de Registros")) = vbYes Then
    MeuRecordSet.Delete
    MeuRecordSet.MovePrevious
    If MeuRecordSet.BOF Then
      MsgBox "Voce chegou no inicio do arquivo ! "
      Exit Sub
    Else
   End If
  End If
End If
erro:   RotinaTratErros

End Sub
Public Sub BtnAdd(MeuRecordSet As Object, MinhaLabel As Control, txtBoxIni As Control)
  On Error GoTo AddErr
  With MeuRecordSet
    If Not (.BOF And .EOF) Then
      mvBookMark = .Bookmark
    Else
    
    End If
    .AddNew
    MinhaLabel.Caption = "Add record"
    mbAddNewFlag = True
      End With
txtBoxIni.SetFocus
  Exit Sub
AddErr:
  MsgBox err.Description
End Sub
Public Sub BtnLocaliza(MeuRecordSet As Object, NomCampoTab As String, MeuLink As String, ImptBoxYN As Boolean, NomTitImputBox As String)
   On Error GoTo erro:
   Dim Resposta As String
   Dim Marca As Variant
   Dim Sim As String
   Dim Não As String
   If ImptBoxYN = True Then
        Resposta = InputBox("Informe o codigo " & NomTitImputBox & " localizar ", "Localizar", Resposta, 1800, 3000)
   Else
        Resposta = MeuLink
   End If
  
   If Resposta <> "" Then
      Marca = MeuRecordSet.Bookmark
   Else
      Exit Sub

   End If
   MeuRecordSet.Find NomCampoTab & "=" & Resposta
   If MeuRecordSet.EOF Then
       MsgBox "Não encontrei o codigo " & Resposta
       MeuRecordSet.Bookmark = Marca
       Exit Sub
erro:       RotinaTratErros
  
   End If
  

End Sub
Public Sub RtnLocaliza(MeuRecordSet As Object, NomCampoTab As String, MinhaStrloc As String)
'Rotina usada conjuntamento com o Form Localizar, ao abrir forms Cadas
   On Error GoTo erro
   Dim Marca As Variant
  
   If MinhaStrloc <> "" Then
      Marca = MeuRecordSet.Bookmark
   Else
      Exit Sub
   End If
   BtnFisrtReg MeuRecordSet
   MeuRecordSet.Find NomCampoTab & "=" & MinhaStrloc
   If MeuRecordSet.EOF Then
            MsgBox "Não encontrei o codigo " & MinhaStrloc
            MeuRecordSet.Bookmark = Marca
        
        Else
            Exit Sub
erro:    RotinaTratErros
   End If

End Sub
Public Sub RtnLocalizaComSub(MeuRecordSet As Object, NomCampoTab As String, MinhaStrloc As String, SubRotinaYN As Boolean, MinhaSub As String)
'Rotina usada conjuntamento com o Form Localizar, ao abrir forms Cadas
   On Error GoTo erro
   Dim Marca As Variant
  
   If MinhaStrloc <> "" Then
      Marca = MeuRecordSet.Bookmark
   Else
      Exit Sub
   End If
   BtnFisrtReg MeuRecordSet
   MeuRecordSet.Find NomCampoTab & "=" & MinhaStrloc
   If MeuRecordSet.EOF Then
        If SubRotinaYN = False Then
            MsgBox "Não encontrei o codigo " & MinhaStrloc
            MeuRecordSet.Bookmark = Marca
        ElseIf SubRotinaYN = True Then
            
        Else
            Exit Sub
erro:    RotinaTratErros
        
        End If
   End If


End Sub
Public Sub lblStatusClick(MinhaLabel As Control, MeuRecordSet As Object)
On Error GoTo erro
'This will display the current record position for this recordset
If CStr(MeuRecordSet.AbsolutePosition) = -1 Then
MinhaLabel.Caption = "Not Data"
Else
  MinhaLabel.Caption = "Reg.: " & CStr(MeuRecordSet.AbsolutePosition) & "/" & MeuRecordSet.RecordCount
End If
erro: RotinaTratErros

End Sub
Public Sub BtnDeletarComExecute(NomTab As String, NomCampoWhere As String, MeuLink As String, CampoMSGBox As String, MeuRecordSet As Object, MsgBYN As Boolean)

On Error GoTo erro

If MeuLink = "" Then
            MsgBox "Não existe Dados Armazenados para Deleção!!!"
Else
        If (MsgBox("Deseja excluir o Registro:  " & CampoMSGBox & "  ?  ", vbYesNo, "Exclusão de Registros")) = vbYes Then
            If MsgBYN = True Then
                sql1 = "DELETE" & " " & "*" & " " & "FROM" & " " & NomTab & " " & "WHERE" & " " & NomCampoWhere & " " & "="
                Sql = sql1 & MeuLink
                db.Execute Sql
                MsgBox "O Registro: " & CampoMSGBox & " - Foi Excluido com Sucesso !!!"
                MeuRecordSet.MovePrevious
                btnRefresh MeuRecordSet
            ElseIf MsgBYN = False Then
                sql1 = "DELETE" & " " & "*" & " " & "FROM" & " " & NomTab & " " & "WHERE" & " " & NomCampoWhere & " " & "="
                Sql = sql1 & MeuLink
                db.Execute Sql
                MeuRecordSet.MovePrevious
                btnRefresh MeuRecordSet
            End If
            
        Else
            If MeuRecordSet.BOF Then
            MsgBox "Você chegou ao início do arquivo"
            Exit Sub
            End If
        End If
End If
erro:   RotinaTratErros
End Sub
Public Sub BtnDeletarComExecuteSemMsgBox(NomTab As String, NomCampoWhere As String, MeuLink As String, MeuRecordSet As Object)
On Error GoTo erro
        If MeuLink = "" Then
            MsgBox "Não existe Dados Armazenados para Deleção!!!"

        Else
               sql1 = "DELETE" & " " & "*" & " " & "FROM" & " " & NomTab & " " & "WHERE" & " " & NomCampoWhere & " " & "="
                Sql = sql1 & MeuLink
                db.Execute Sql
                MeuRecordSet.MovePrevious
                btnRefresh MeuRecordSet
            
        If MeuRecordSet.BOF Then
      MsgBox "Voce chegou no inicio do arquivo ! "
      Exit Sub
erro:   RotinaTratErros
    
    Else
   End If
  End If
End Sub
Public Sub BtnAbrirFormDeOutroForm(Nomforme As Form, NomformOpen As Form)
StrLoc = Nomforme.Name
NomformOpen.Show
Unload Nomforme
End Sub

     
Everest
BARRA MANSA
RJ - BRASIL
Postada em 27/06/2006 17:12 hs            
É galera vlw msm.  2 anos sem programar em VB :X
 
eu me lembrei de que eu posso inspecionar os objetos ou classe dai eu vi que algumas propriedades do ADO estao ocultas
 
 
T+
     
Página(s): 1/1    

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