[Desistência]Gerenciar Recordset automático em formulários

Bom dia a todos do Máximo Access,
Estou com algumas atualizações no meu Projeto 2013, e a questão é que cosegui um bom bocado de conhecimento aqui, e já fiz algo incrível, a questão do que venho abrir este tópico é gerar um RecordSet automático para todos os formulários usando simplemente uma função do módulo.

Consegui fazer este código, porém estou com problemas em adicionar mais linhas em subformulário, só está adicionando 1 linha e não passa disso, não tem como criar uma nova linha ou registro.

Trabalho com DAO e estou tentando trabalhar com ele Desconectado(Desacoplado) mas não estou tendo sucesso com subformulário, estou um bocado de tempo tentando fazer algo, mas nada vem a mente, estou quase apelando para uma tabela temporária...

Veja o que tenho:

Módulo:

Código:


Option Compare Database

Public Function caminho() As String
    caminho = Application.CurrentProject.Path & "\Ideias_be.accdb"
End Function

Public Function fecha()
On Error Resume Next
    rs.Close: Set rs = Nothing
    db.Close: Set db = Nothing
End Function

Public Function abre(SQL As String, frm As Form)
On Error Resume Next 'GoTo Error:
    Dim ctl As Control
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Set db = OpenDatabase(caminho, False, False)
    Set rs = db.OpenRecordset(SQL)
    Dim Campo As Variant
    Dim X As Variant
    Dim Y As Variant
    'Pega todos os controles
    For Each ctl In frm.Controls
        Select Case ctl.ControlType
            Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
                'Execução
                    If ctl.Name <> "" Or Not IsNull(ctl.Name) Then
                    X = "" & ctl.Name
                    ctl.Value = rs(X)
            End If
            'Fim de Execução
        End Select
    'Próximo controle
    Next ctl
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
    Exit Function
Error:
MsgBox "Teste - " & Err.Description & " Nº: " & Err.Number
End Function

Public Function abre2(SQL As String, frm As Form)
On Error Resume Next 'GoTo Error:
    Dim ctl As Control
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Set db = OpenDatabase(caminho, False, False)
    Set rs = db.OpenRecordset(SQL)
    Dim Campo As Variant
    Dim X As Variant
    Dim Y As Variant
    Dim i As Integer
    Y = rs.RecordCount
    'Pega todos os controles
        For i = 1 To 2
    For Each ctl In frm.Controls
        Select Case ctl.ControlType
            Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
                'Execução
                    If ctl.Name <> "" Or Not IsNull(ctl.Name) Then
                    X = "" & ctl.Name
                    ctl.Value = rs(X)
            End If
            'Fim de Execução
        End Select
    'Próximo controle
    Next ctl
        rs.FillCache
        rs.MoveNext
        Next i
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
    Exit Function
Error:
MsgBox "Teste - " & Err.Description & " Nº: " & Err.Number
End Function

Public Function Combo(Campo As String, frm As Form) 'Carrega combo com lista em recordset linha por linha

On Error GoTo Error
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim j As Integer
    Dim k As Variant
    Set db = OpenDatabase(caminho)
    Set rs = db.OpenRecordset("SELECT " & Campo & " FROM Funcionario ORDER BY Codigo")

        Do Until rs.EOF
        k = rs(Campo)
        j = j + 1
        With frm(Campo)
        .AddItem k
        End With
        'Me.AprovadoGerente.AddItem "0;Reprovado", Index:=0
        rs.MoveNext
    Loop
    Call fecha
    Exit Function
Error:
MsgBox "Teste - " & Err.Description & " Nº: " & Err.Number
End Function


Formulário:

Código:


Option Compare Database
Option Explicit

Private Sub Codigo_AfterUpdate()
Call abre("SELECT * FROM Funcionario WHERE Codigo =" & Me.Codigo, Me)
Call abre2("SELECT * FROM FuncionarioSub WHERE Codigo =" & Me.Codigo, Me.FuncionarioSub.Form)
End Sub

Public Sub Form_Open(Cancel As Integer)
Call abre("SELECT * FROM Funcionario", Me)
Call Combo("Codigo", Me)
Call abre2("SELECT * FROM FuncionarioSub WHERE Codigo =" & Me.Codigo, Me.FuncionarioSub.Form)
End Sub


O que já tenho pronto é, pegar todos os campos dos formulários e salvar em uma tabela, uso este código:

Código:


Public Function frmX(frm As Form) 'Verifica todos os campos e subformulário do formulário
    Dim ctl As Control
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Set db = OpenDatabase(caminho, False, False)
    Dim Item As Integer
    Dim cont As Integer
On Error GoTo Error
DoCmd.SetWarnings False
db.Execute "DELETE * FROM tblFormCampos WHERE NomeForm ='" & frm.Name & "'"

For Each ctl In frm.Controls
' Percorre todos os tipos de controles
Select Case ctl.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
       
 If ctl.Name <> "" Or Not IsNull(ctl.Name) Then
  Set rs = db.OpenRecordset(SQLi("Campo", "tblFormCampos", "NomeForm = '" & frm.Name & "' And Campo = '" & ctl.Name & "'"))
  Item = Item + 1
  cont = rs.RecordCount
  If cont = 0 Then
  db.Execute "INSERT INTO tblFormCampos (NomeForm, Item, Campo, SubForm) Values('" & frm.Name & "', '" & Item & "', '" & ctl.Name & "', '-')"
  Set rs = Nothing
  End If
 End If
 
Case acSubform

 If ctl.Name <> "" Or Not IsNull(ctl.Name) Then
  Set rs = db.OpenRecordset(SQLi("SubForm", "tblFormCampos", "NomeForm = '" & frm.Name & "' And SubForm = '" & ctl.Name & "'"))
  Item = Item + 1
  cont = rs.RecordCount
  If cont = 0 Then
  db.Execute "INSERT INTO tblFormCampos (NomeForm, Item, SubForm, Campo) Values('" & frm.Name & "', '" & Item & "', '" & ctl.Name & "', '-')"
  Set rs = Nothing
  End If
 End If

End Select
Next ctl


DoCmd.SetWarnings True

db.Close
Set db = Nothing
Exit Function
Error:
msgbox "(FrmX).Percorre todos os campos - " & Err.Description & " Nº: " & Err.Number
End Function

Agora estou tentanto e tentando, mas sem sucesso até então, pegar todos os registros desta tabela onde foi salvo e trazer até ao módulo de chamar os recordset e aplicar no módulo com "imagino eu usando um for each ou do loop" cada campo salvo com !campo1 !campo2 !campo3 automáticamente sem o usuário ter que digitar todos os campos daquele formulário.

Alguém por favor pode dar uma luz de como eu vou extrair as informações da tabela e trazer para o módulo, aplicando com um procedimento (DLookUp Concatenado, ou Each For, ou Do While Loop...) assim o usuário não precisaria digitar sempre que fazer um formulário novo, só chamando a repectiva função!

Aguardo Sugestões Abraços a todos!

Veja um exemplo de recordset onde se utiliza o nome do campo em uma variável...

Dim rst As DAO.Recordset, i As Integer
Set rst = CurrentDb.OpenRecordset("SELECT " & CampoID & " FROM " & NomeTabela & " WHERE Not IsNull(ID) ORDER BY ID;")

podes de acordo com os campos preenchidos na tabela, contar os campos da mesma...e direcionar ao Rst com igual numero de campos, algo assim

'Para 1 campo
Set rst = CurrentDb.OpenRecordset("SELECT " & CampoID & " FROM " & NomeTabela & " WHERE Not IsNull(ID) ORDER BY ID;")
'Para 2 campos
Set rst = CurrentDb.OpenRecordset("SELECT " & CampoID & " & "," & " & Campo1 & " FROM " & NomeTabela & " WHERE Not IsNull(ID) ORDER BY ID;")


é uma ideia.

Saudações Piloto!

O que preciso não é isto, o que preciso é um comando que ele extrai as informações da tabela, filtrado pelo nome do formulário como no exemplo abaixo:

"SELECT Campos FORM Formulario WHERE NomeFormulario = '" & frm.name & "'

Depois eu contaria a quantidade de registros encontrador.

Contador = Quantidade de registros

e então usaria um [ For I 1 To Contador ]
E cada passo que o For I desse, ele pegaria as informações e salva-se em uma Variavel, logo em seguida ele aplicava a informação que seria o nome do campo salvo na tabela e setava como:

frm.(Campo(1)) = rs(Campo(1))

E faria o loop de novo... até preencher todos os campos do formulário e então encerra-se a conexão.

Resumindo:
Pegar as informações da tabela, aplica-las com um recodset, desconectar o recordset e o banco para que eu possa trabalhar com desvinculado.

Obs: Juro que fiz algo melhor que isso 3 vezes, Ontem quando estava caindo uma tempestade, a energia caiu duas vezes, e hoje deu tela azul e não salvou o que eu queria te enviar de verdade, mas caso você queira que eu envie uma idéia mais clara eu envio, mas desta vez serei mais ligeiro, pois eu fiquei muito nervoso de fazer 3 vezes e não conseguir te enviar

Um select baseado no nome do form.... Não creio ser possivel...

se deseja pegar os dados da tabela que esta atrelada ao form... talvem o RecodsetClone resolve..

Veja tambem sobre RecordSource...

Boas novas!
Piloto, consegui algo incrível aqui, bom pelo menos para mim por enquanto rsrs...

Bom consegui o que eu queria, porém só existe um problema, ele não está preechendo o subformulário, não consigo inserir mais do que 1 linha, você tem uma idéia? vou lhe passar os código:

Módulo:

Código:


Option Compare Database

Public Function caminho() As String
    caminho = Application.CurrentProject.Path & "\Ideias_be.accdb"
End Function

Public Function fecha()
On Error Resume Next
    rs.Close: Set rs = Nothing
    db.Close: Set db = Nothing
End Function

Public Function abre(SQL As String, frm As Form)
On Error Resume Next 'GoTo Error:
    Dim ctl As Control
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Set db = OpenDatabase(caminho, False, False)
    Set rs = db.OpenRecordset(SQL)
    Dim Campo As Variant
    Dim X As Variant
    Dim Y As Variant
    'Pega todos os controles
    For Each ctl In frm.Controls
        Select Case ctl.ControlType
            Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
                'Execução
                    If ctl.Name <> "" Or Not IsNull(ctl.Name) Then
                    X = "" & ctl.Name
                    ctl.Value = rs(X)
            End If
            'Fim de Execução
        End Select
    'Próximo controle
    Next ctl
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
    Exit Function
Error:
MsgBox "Teste - " & Err.Description & " Nº: " & Err.Number
End Function

Public Function abre2(SQL As String, frm As Form)
On Error Resume Next 'GoTo Error:
    Dim ctl As Control
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Set db = OpenDatabase(caminho, False, False)
    Set rs = db.OpenRecordset(SQL)
    Dim Campo As Variant
    Dim X As Variant
    Dim Y As Variant
    Dim i As Integer
    Y = rs.RecordCount
    'Pega todos os controles
        For i = 1 To 2
    For Each ctl In frm.Controls
        Select Case ctl.ControlType
            Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
                'Execução
                    If ctl.Name <> "" Or Not IsNull(ctl.Name) Then
                    X = "" & ctl.Name
                    ctl.Value = rs(X)
            End If
            'Fim de Execução
        End Select
    'Próximo controle
    Next ctl
        rs.FillCache
        rs.MoveNext
        Next i
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
    Exit Function
Error:
MsgBox "Teste - " & Err.Description & " Nº: " & Err.Number
End Function

Public Function Combo(Campo As String, frm As Form) 'Carrega combo com lista em recordset linha por linha

On Error GoTo Error
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim j As Integer
    Dim k As Variant
    Set db = OpenDatabase(caminho)
    Set rs = db.OpenRecordset("SELECT " & Campo & " FROM Funcionario ORDER BY Codigo")

        Do Until rs.EOF
        k = rs(Campo)
        j = j + 1
        With frm(Campo)
        .AddItem k
        End With
        'Me.AprovadoGerente.AddItem "0;Reprovado", Index:=0
        rs.MoveNext
    Loop
    Call fecha
    Exit Function
Error:
MsgBox "Teste - " & Err.Description & " Nº: " & Err.Number
End Function


Formulário:

Código:


Option Compare Database
Option Explicit

Private Sub Codigo_AfterUpdate()
Call abre("SELECT * FROM Funcionario WHERE Codigo =" & Me.Codigo, Me)
Call abre2("SELECT * FROM FuncionarioSub WHERE Codigo =" & Me.Codigo, Me.FuncionarioSub.Form)
End Sub

Public Sub Form_Open(Cancel As Integer)
Call abre("SELECT * FROM Funcionario", Me)
Call Combo("Codigo", Me)
Call abre2("SELECT * FROM FuncionarioSub WHERE Codigo =" & Me.Codigo, Me.FuncionarioSub.Form)
End Sub


Ninguém tem ou teve alguma idéia?

Para o sub Form tente carregar o Recordset do mesmo

Set Me.recordset = CurrentDb. blablabla


Cumprimentos.

Saudações!
Piloto, da uma olhadinha no projeto, eu não estou setando recordset pq o DAO não trabalha com recordset desconectado, eu estou usando o formulário desvinculado, é por isso que gostaria de algum jeito para retornar todos os registros do subformulário, mas com mais de uma linha pois só retorna a primeira linha...

eu abro o recordset, puxo as informações e colo nos campos automáticamente, do mesmo jeito no sub, mas no sub o problema é que só puxa a primeira informação, e estou tentando de vários jeito, sei que existe um jeito mas ainda não o encontrei...

Abraços!

Ouve Desistencia neste projeto, pois era inviável trabalhar desta forma. Penso eu.

Olá RneoX

Uma vez quis fazer algo parecido e retornava apenas um registro, não conformado fiz algumas pesquisas encontrei a resposta nesse tópico leia até o final.