Bem amigos deixo esta pequena função e um exemplo de código utilizando a mesma em um loop em recordset..
Escrevento na lista os registros encontrados no mesmo
Função:
'Escreve log's em listBox no Form
Private Sub EscreveLog(msg As String)
On Error GoTo TrataErro
' adiciona menssagem
Lista.RowSource = Lista.RowSource & msg & ";"
Lista = Lista.ItemData(Lista.ListCount() - 1)
Exit Sub
TrataErro:
MsgBox Error, , Err
End Sub
Exemplo de uso em um recordset
Dim db As DAO.Database
Dim ws As DAO.Workspace
Dim rs As DAO.Recordset
Dim NomeBD As String
Dim StrPath As String
Dim StrSQLDigital As String
NomeBD = "Bio_be.accdb"
'String com path para conexão com a base de dados.Aqui utilizo uma função minha para o Caminho do BD (DirBancoDados) mas pode ser substituida pelo CurrentProject.Path
StrPath = DirBancoDados & NomeBD ' Conecta ao banco de dados comum
Set db = OpenDatabase(StrPath)
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase(DirBancoDados & "\Bio_Be.accdb", False, False, "MS Access;PWD=senha")
'Aqui aplico a SQL Filtrada pela ID
StrSQLDigital = ("SELECT * FROM tblDigital WHERE ID_Detento =" & Me.CboDetento.Column(0) & "")
Set rs = db.OpenRecordset(StrSQLDigital) 'Abro o recordset com a SQL acima
rs.FindFirst "ID_Detento = " & Me.CboDetento.Column(0) ' Encontrar primeiro registro com o código do detento.
If rs.NoMatch Then ' Se o código ainda não está cadastrado...
'Aqui aplico a função para a condição de não haver registro para a ID
EscreveLog ("Não há registros para este Detento em Digitais")
Else ' ... caso contrário...
EscreveLog ("Foram encontrado os seguintes registros para este Detento:")
Do While Not rs.EOF
'Aqui aplico a função inserindo nela campos do recordset, aqui serão gravados na log quantos registros contiverem no recordset filtrado
EscreveLog ("" & rs!Dedo & "" & " " & "" & rs!Mao & "")
rs.MoveNext
Loop
End If
Saudações
Escrevento na lista os registros encontrados no mesmo
Função:
'Escreve log's em listBox no Form
Private Sub EscreveLog(msg As String)
On Error GoTo TrataErro
' adiciona menssagem
Lista.RowSource = Lista.RowSource & msg & ";"
Lista = Lista.ItemData(Lista.ListCount() - 1)
Exit Sub
TrataErro:
MsgBox Error, , Err
End Sub
Exemplo de uso em um recordset
Dim db As DAO.Database
Dim ws As DAO.Workspace
Dim rs As DAO.Recordset
Dim NomeBD As String
Dim StrPath As String
Dim StrSQLDigital As String
NomeBD = "Bio_be.accdb"
'String com path para conexão com a base de dados.Aqui utilizo uma função minha para o Caminho do BD (DirBancoDados) mas pode ser substituida pelo CurrentProject.Path
StrPath = DirBancoDados & NomeBD ' Conecta ao banco de dados comum
Set db = OpenDatabase(StrPath)
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase(DirBancoDados & "\Bio_Be.accdb", False, False, "MS Access;PWD=senha")
'Aqui aplico a SQL Filtrada pela ID
StrSQLDigital = ("SELECT * FROM tblDigital WHERE ID_Detento =" & Me.CboDetento.Column(0) & "")
Set rs = db.OpenRecordset(StrSQLDigital) 'Abro o recordset com a SQL acima
rs.FindFirst "ID_Detento = " & Me.CboDetento.Column(0) ' Encontrar primeiro registro com o código do detento.
If rs.NoMatch Then ' Se o código ainda não está cadastrado...
'Aqui aplico a função para a condição de não haver registro para a ID
EscreveLog ("Não há registros para este Detento em Digitais")
Else ' ... caso contrário...
EscreveLog ("Foram encontrado os seguintes registros para este Detento:")
Do While Not rs.EOF
'Aqui aplico a função inserindo nela campos do recordset, aqui serão gravados na log quantos registros contiverem no recordset filtrado
EscreveLog ("" & rs!Dedo & "" & " " & "" & rs!Mao & "")
rs.MoveNext
Loop
End If
Saudações