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
|
|
|
|
|
|
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
|
|
|
|
|
|
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+ |
|
|
|
|
