Funções DLookup,DCount,DMax,DMin em front-end desvinculado

Olá amigos

Estou elaborando alguns arquivos exemplos, para um novo produto que irei lançar e pretendo oferecer as funções D (Dlookup,Dsum,Dcount,Dmax,..) e assim facilitar o uso da programação aos menos experientes.

Estou recriando todas elas, haja visto que sem a presença das tabelas estas perdem sua funcionalidade.

Pergunto: Alguém tem estas funções prontas, para eu poder comparar com as que estou elaborando ? Já venho a 2 dias testando as minhas, mas queria ver se estou pisando na bola em algum detalhe.

Grato!

Olá Avelino

Não entendi bem o que pretende.
No entanto, tenho esta função que me tem facilitado a procura de valores nulos, em campos de tipos diversos.
Em vez de
If isnull(dlookup... then
...
else
...
end if
Coloco
ProcNulo(...

Function ProcNulo(strCampo As String, strTabela As String, strCriterio As String, varDevolvida As VbVarType, varDevolvidaSeNulo As VbVarType, Optional varDevolvidasSeBoleanoZero As VbVarType)
'Criada por Alexandre Neves - www.esnips.com/web/AlexandreNeves

If IsNull(DLookup(strCampo, strTabela, strCriterio)) Then
Select Case varDevolvidaSeNulo
Case 11 'vbBoolean
ProcNulo = 0
Case 5 'vbDouble
ProcNulo = 0
Case 2 'vbInteger
ProcNulo = 0
Case 3 'vbLong
ProcNulo = 0
Case 1 'vbNull
ProcNulo = Null
Case 4 'vbSingle
ProcNulo = 0
Case 8 'vbString
ProcNulo = ""
End Select
Else
Select Case varDevolvida
Case 11 'vbBoolean
ProcNulo = DLookup(strCampo, strTabela, strCriterio)
If ProcNulo = 0 And Not IsMissing(varDevolvidasSeBoleanoZero) Then
Select Case varDevolvidasSeBoleanoZero
Case vbNull
ProcNulo = Null
Case 0
ProcNulo = 0
Case 1
ProcNulo = -1
End Select
End If
Case 5 'vbDouble
ProcNulo = CDbl(DLookup(strCampo, strTabela, strCriterio))
Case 2 'vbInteger
ProcNulo = CLng(DLookup(strCampo, strTabela, strCriterio))
Case 3 'vbLong
ProcNulo = CLng(DLookup(strCampo, strTabela, strCriterio))
Case 1 'vbNull
ProcNulo = Null
Case 4 'vbSingle
ProcNulo = CSng(DLookup(strCampo, strTabela, strCriterio))
Case 8 'vbString
ProcNulo = CStr(DLookup(strCampo, strTabela, strCriterio))
Case vbDate
ProcNulo = CDate(DLookup(strCampo, strTabela, strCriterio))
End Select
End If
End Function

Olá amigo Alexandre!

Muito obrigado pela sua coloboração. Não é isso que desejo.

veja, quando usamos front-end desvinculados não existem tabelas nem consultas no front-end, portanto não é possível usar as funções agregadas. Exemplo:

me!meucampo = DLookup("meucampo", "nomeDaTabela", filtro)

Não é possivel usar a função porque não existe a tabela a ser apontada. Perdemos com isso uma certa flexibilidade, que estavamos tanto acostumados! Minha intensão então e recria-las para se ganhar em produtividade.

Grato!

Pois,

Não trabalho com desvínculos, mas outros colegas contribuirão concerteza.
Abraços,

Ninguém mesmo possui este tipo de padronização, para front-end desvinculado?

Creio que se não tivermos estas funções padronizadas, cada momento que precisarmos de algo (pesquisar,somar,contar,...) é "dale código!"

No aguardo

Bom dia Avelino,

Acho que a sua duvida tem haver com este Link

Grande Avelino...
Eu, dependendo do caso, costumo aproveitar a conexão aberta, e uso o RecordCount, para contar...
Já para pesquisa, abro o RecordSet filtrando com a cláusula WHERE da SQL.
Para somar, uso também a WHERE para especificar o que quero somar...

Essa é minha forma, que dá um trabalhinho, mas já estou meio automático em fazer isso...

Opa, Charles! Já ficou mais empolgante!

O Gilberto apresentou o Dlookup() bem interessante, tirado lá do MSDN.

Código:

FONTE: MSDN
Public pdbs As Database
Const APP_NAME = "Teste de Função"

Function DLookupISD(ByVal FieldName As String, ByVal RecSource As String, _
                ByVal Criteria As String) As Variant
Dim dsResult As Recordset
Dim ReturnValue As Variant


On Error Resume Next
 Dim MyDb As Database
 
  Set MyDb = DBEngine.Workspaces(0).OpenDatabase(MeuBackEND")
  Set dsResult = MyDb.OpenRecordset(RecSource, dbOpenDynaset)
  With dsResult
      If Criteria = "" Then
        Criteria = FieldName & " Valor Nulo"
      End If
      .FindFirst Criteria
      If Not .NoMatch Then
        DLookupISD = dsResult(FieldName).value
      Else
        DLookupISD = Null
      End If
     
      .Close
  End With
  Exit Function
End Function

Irei realizar testes e ver se os resultados batem com o Dlookup Original.

Grato!

Opa, Marcelo!

Então, a idéia é que agente tenha uma coleção dessas funções prontas, para agilizar o nosso dia a dia.

Está dando trabalho agora, mas depois é só usar da forma como estamos habituados.

Valeu!

Pode ajudar em aguma coisa:


Public Function jPesquisa(ByVal Campo As String, ByVal Tabela As String, ByVal Criterio As String) As Variant
DoCmd.Hourglass True

Dim strConnect As String
'esta é a string de conexao
'devera conter a informacao sobre o provedor e o
'caminho do banco de dados
Dim strProvider As String
'guarda o nome do provedor
Dim strDataSource As String
'guarda a fonte de dados
Dim strDataBaseName As String
'nome do banco de dados

' string de conexao
strConnect = "driver={MySQL ODBC 5.1 Driver};server=SERVIDOR;uid=USUARIO;pwd=SENHA;database=DATABASE"

Set adoDataConn = New ADODB.Connection
'preparando o objeto connection
adoDataConn.CursorLocation = adUseClient
'usamos um cursor do lado do cliente pois os dados
'serao acessados na maquina do cliente e nao de um servidor
adoDataConn.Open strConnect
'Abreo o objeto connection
Set rsmysql = New ADODB.Recordset
'Prepara o recordset
rsmysql.CursorType = adOpenStatic
'Este é o unico tipo de cursor a ser usado
'com um cursor localizado no lado do cliente
rsmysql.CursorLocation = adUseClient
'estamos usando o cursor no cliente
rsmysql.LockType = adLockPessimistic
'Isto garente que o registros que esta sendo editado
'pode ser salvo
rsmysql.ActiveConnection = adoDataConn
'O recordset precisa saber qual a conexao em uso
rsmysql.Source = "Select * From " & Tabela & " WHERE " & Criterio 'altere para tabela que desejar
'a fonte de dados usamos uma instrucal SQL
rsmysql.Open
'abre o recordset com isto o evento MoveComplete sera disparado
jPesquisa = rsmysql.Fields(Campo).Value
'popula o campo
Set rsmysql = Nothing
'limpa a memória
DoCmd.Hourglass False
'**********************************************************************************
'Chamada: EXEMPLO
'Me.Desc_Tipo = jPesquisa("Desc_Tipo", "Comp_Tipo", "ID_Tipo=" & Me.ListaComp.Column(5))
'**********************************************************************************

Eu somente utilizo SQL no VBA;

Exemplo de um DLookup:



Dim db As Database
Dim strFiltra As String, strSQL As String
Set db = CurrentDb()

Dim rs As Recordset
strSQL = "SELECT Nome FROM TabelaNomes IN '\\SERVIDOR\BACKEND.mdb' WHERE Nome = 'JPaulo'"
Set rs = db.OpenRecordset(strSQL)

If rs.RecordCount > 0 Then
strFiltra = rs!Nome
Me.CaixaTexto.Value = strFiltra
End If
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing


O mesmo se aplica para um DCount, DMax, DMin ......

Show de bola a participação de vocês!

Todas as funções até aqui apresentadas ainda estão incompletas.  A que mais se aproximou da que elaborei foi a do João Paulo.

Explico o por que do incompleto:

Observe os argumentos da função: Dlookup(Expr,Domain,Criteria)

Observou bem que o primeiro argumento é uma EXPRESSÃO e não especificamente um CAMPO.  Isto significa que podemos extrair valores de varias formas.  Exemplos:

1) Podemos concatenar campos

Dlookup("[campo1] & [campo5]","nomeDatabela")

2) Podemos obter um valor já calculado.

Dlookup("[campo1] + [campo5]","nomeDatabela")

Dlookup("(([campo1] + [campo5])/100)","nomeDatabela")

Agora uma questão sobre DESEMPENHO

Já ví pessoas aqui populando campos da seguinte forma:

me!campoA = Dlookup("campo1","NomeDaTabela",filtro)
me!campoB = Dlookup("campo2","NomeDaTabela",filtro)
me!campoC = Dlookup("campo3","NomeDaTabela",filtro)
me!campoD = Dlookup("campo4","NomeDaTabela",filtro)
me!campoE = Dlookup("campo5","NomeDaTabela",filtro)

Ou seja, foram dadas 5 viagens a tabela.

Agora que você sabe que podemos concatenar campos num único Dlookup, veja como fica um código alternativo:

Código:

Dim seq As String, k
seq = "[campo1] & '|' & [campo2] & '|' & [campo3] & '|' & [campo4] & '|' & [campo5]"
seq = Dlookup(seq, "NomeDaTabela", Filtro)
k = Split(seq, "|")
Me!campoA = k(0)
Me!campoB = k(1)
Me!CampoC = k(2)
Me!CampoD = k(3)
Me!CampoE = k(4)

Conclusão:

Com isso reduzimos de 5 para apenas 1 viagem a tabela. (DESEMPENHO)
Podemos então utilizar o Dlookup para popular campos de formulários desvinculados.
Se tivermos o Nosso Dlookup no front-end desvinculado, poderemos popular campos da mesma forma, se assim desejarmos.  
O Nosso Dlookup tem que ser capaz de lidar com expressões e não somente com um campo.

Valeu!

Bom dia Avelino e os demais;

Grande aprendizado para todos nós, estes são os tópicos que maior valor tem neste fórum, por isso vai ser pinado para não se perder na imensidão de tópicos.

Olá!

Já não aguento mais realizar testes!(risos) Estou ficando zureta de tanto ler os helps dessas funções, para que não escape nenhum detalhe.

Temos que saber o retorno de cada função para cada tipo de situação, ou seja, quando retorna NULL, quando retorna Vazio, Quando retorna ZERO e quando deve retornar com mensagem de erro.

Peço ajuda de vocês, para que tenhamos uma padronização.

Estou oferecendo um arquivo, em MDB, com todas as funções D que elaborei. Elas sofreram uma pequena adaptação, para funcionar com tabelas locais. Assim todos podem participar dos testes.

Faça um teste com as funções do Access e compare com as funções oferecidas. Basta acrescentar a letra X no final

exemplo:

Dlookup("Nomecliente","tblClientes") > esta é a função do Access
DlookupX("Nomecliente","tblClientes") > esta é a função criada.

Aquele que encontrar erro, reporte aqui no tópico.

Grato!

Baixe aqui o Arquivo MDB

Nossa!! muito bom esse código! Acabei de testar o DlookupX! Um sucesso!
O tratamento de erro muito interessante e até o "Auto listar membros" está disponível! Como fêz isso? Incrível!
Vou testar as outras funções....

Rapaz, o que estão fazendo que ainda não te chamaram para a equipe do Access na Microsoft?

Parabéns amigão, só temos a ganhar com você por aqui, isso facilitará e muito a nossa vida!
Agora tenho um motivo a mais em continuar trabalhando desvinculado!

muito bom, mas uma duvida

a função DMinX popula o forms com o ultimo registro que deveria ser a DMaxX, me diga porquê ?

senhor Avelino também a DFirstX popula o ultimo registro da tabela.

Olá Raquel! Muito obrigado pela participação e pelos testes.

Dmax e Dmin retornam valores máximos e minimos de valores numéricos ou ultima/Primeira sequencia quando se tratar de valor do tipo string.

No exemplo que forneci tem a tabela tblParcelas.

Me mostre um exemplo de escrita, que não está retornando o valor esperado.

Exemplo:

=DMaxX("valorParcela","tblParcelas")

No aguardo

Marcelo, muito obrigado por se disponibilizar em testar.

No aguardo.

Boa tarde, Avelino

Percorri o código para tentar descobrir alguma inconsistência que porventura pudesse esquecer ao introduzir dados particulares.
Apenas alterava duas partes:
1 - Não gosto do ... is null. Prefiro isNull(...)
2 - Inicializava as variáveis utilizadas (soma e j)
Parabéns pela contribuição.

Olá Mestre Avelino, Parabens pelo aplicativo,

Ate agora não encontrei erros(Risos), estarei fazendo testes aqui e qualquer novidade informo.

Sucesso e parabens!!!

Olá Alexandre!

Desculpa pela demora em responder.

1 - Não gosto do ... is null. Prefiro isNull(...)

Ok, irei seguir a sua sugestão.

2 - Inicializava as variáveis utilizadas (soma e j)

Não considero necessário, porque as variáveis tem escopo local e elas possuem valor padrão quando nascem. (vazio para variantes, 0 para números e false para boolean)

Muito obrigado pela sua ótima colaboração!

Olá Danilo!

Valeu pela força!

Olá Raquel!

Andei pensando bastante nos seus comentários e confesso que não estou conseguindo enxergar a problema que vc reportou. Por favor, me ofereça mais detalhes, de como realizou o teste.

No aguardo

Olá Raquel!

Acho que matei a xarada do que vc está querendo me reportar. É que no meu exemplo do formulário, a função está com um filtro em que só retorna um único registro.

seq = DFirstX(seq, "tblParcelas", "numParcela =4")

Tire o filtro e volte a realizar o teste.

seq = DFirstX(seq, "tblParcelas")

ou

seq = DMaxX(seq, "tblParcelas")


No aguardo

bom dia Avelino é isso aí tirei o filtro e deu direitinho, mas se eu quiser filtrar ?

Vc pode usar a filtragem normalmente. O filtro que estava aplicado foi que trouxe confusão na análise, porque ele só retornava um único registro. Então não importava se era máximo, minimo, primeiro ou último.

Fico muito agradecido pelo apoio.

muito bom mesmo.
que deus te ilumine sempre a tua sabedoria.

Eu estava justamente precisando disso, maravilhoso este tópico.

Mestre Avelino vi que você usa muito a variável k,

fiquei com uma dúvida:

Como grande mestre que és, deve ter seus motivos, mas por que ao invés de usar

dim seq As String, k no evento click do botão, não utilizou um

Public seq As String, k no módulo mod_funcoes_D

juntamente com:

seq = Null 'Em caso de existir na função.
k = Null

no final de cada procedimento?

Evitaria a digitação de dim seq As String toda vez que fosse utilizar tais procedimentos.

É só uma dúvida!


Abraços

Olá Glicério

Acho que vc fez um pouco de confusão. A letra K que vc observou nas funções se trata de um NOME dado a expressão e não a uma VARIÁVEL

Select (" & NomeCampo & ") AS k ...

Por se tratar de uma expressão é preciso dar um nome com a clausula AS para que fica mais fácil a sua identificação (rs("k")). Usei K como variável no botão por pura coincidência. Lembrando que se não definirmos um nome, o Access definirá algo assim: Expr1000.

Seguindo ainda seu raciocínio, que eu entendi perfeitamente, te farei uma pergunta: Qual seria a vantagem das variáveis globais, já que vc tem que zerar no final, usando o null ? No fim teria que perder tempo em digitação, mais ou menos com a mesma quantidade de caracteres.

Cada caso é um caso. Por exemplo, se dentro do formulário tivesse seguidas repetições no uso das variáveis, já colocaria as variáveis topo do formulário com uso do PRIVATE e não do PUBLIC. Com isso não precisaria me preocupar em zera-las.

Valeu!

Parabéns pelas funções Avelino.

Amigo Avelino, no caso da tua função Dcounx, como seria a utilização da mesma para contar registros filtrados por uma expressão entre datas?

Ótimo tópico tambem

Não participei ainda por falta de tempo. Agenda apertada aqui

Opa, Harysohn!

Amigão, use o Dcount() do Access. Depois de obter o resultado esperado, acrescente o X no final do nome da função e veja se irá obter o mesmo resultado. Se encontrar resultado diferente, reporte aqui exatamente como fez, para que eu possa corrigir. O DcountX não pode fazer nada diferente do que faz a função original.

Vc encontrou resultado diferente?

a função que estou utilizando:
Private Sub Comando6_Click()
If Verifica = False Then
MsgBox "Falso"
Else
MsgBox "Verdadeiro"
End If

End Sub

Function Verifica() As Boolean
If DCountX("*", "tblExemplo", "DataPagamento <=#" & Date & "# And DataPagamento >=#" & DateAdd("m", -6, Date) & "#") >= 1 Then
StrCns = True
Verifica = True
Else
StrCns = False
Verifica = False
End If
End Function


Utilizando o DCount X, obteve o resultado esperado, assim como na função original

Perfect!

Valeu pelo teste, Harysohn!

Dúvida tirada! muito obrigado grande mestre.

Olá

Darei uma boa reduzida na escrita das funções, pois em mais testes aqui percebi que as funções: max, min, first, last, soma e contar , usadas nas consultas TOTAIS(AGRUPAMENTOS) trazem os resultados esperados.

Por exemplo, na função DmaxX estarei utilizando a funçã max()

De:

strSQL = "Select (" & NomeCampo & ") AS k FROM " & nomeTabela & " WHERE Not isnull(" & NomeCampo & ") " & IIf(filtro = "", "", " AND " & filtro) & " ORDER BY " & NomeCampo & " DESC;"

Para:

strSQL = "Select max(" & NomeCampo & ") AS k FROM " & nomeTabela & IIf(filtro = "", ";", " WHERE " & filtro & ";")

Desta forma já nos traz o valor sem precisar percorrer os registros como estava fazendo.

Assim que terminar os testes, retorno com as modificações.

Se alguém encontrar uma falha no uso destas funções me retorne.

Grato!

Olá amigos!

Bom, conclui os testes e me dou por satisfeito! Usar as consultas AGRUPAMENTOS resolveram a questão de forma ultra simples. Acredito que as funções originais sejam desta forma.

Segue as alterações.

Eu acrescentei no exemplo um módulo chamado de mod_conexao.

Para alterar as funções D , de modo que funcione para front-end desvinculado, basta acrecentar os procedimentos abreconexao e fechaconexao.

Exemplo da função DlookupX:

Código:

Public Function DlookupX(NomeCampo As Variant, nomeTabela As Variant, Optional filtro As String = "") As Variant
Dim rs As DAO.Recordset
On Error GoTo trataerro
Dim strSQL As String
strSQL = "Select (" & NomeCampo & ") AS k FROM " & nomeTabela & IIf(filtro = "", ";", " WHERE " & filtro & ";")
call abreconexao(101010)
Set rs = bd.OpenRecordset(strSQL, 4)
DlookupX = rs!k
rs.Close
Set rs = Nothing
sair:
    call fechaconexao
    Exit Function
trataerro:
Select Case Err.Number
    Case 3061: MsgBox "DLookupX - Campo inexistente...", vbInformation, "Aviso"
    Case 3031: MsgBox "DLookupX - Conexão fechada com a base de dados...", vbInformation, "Aviso"
    Case 3078: MsgBox "DlookupX - Tabela inexistente...", vbInformation, "Aviso"
    Case 3464: MsgBox "DlookupX - Tipos de dados incopatíveis...", vbInformation, "Aviso"
    Case 3021: DlookupX = Null
    Case Else
        MsgBox "DLookupX - " & Err.Description & " Nº: " & Err.Number
End Select
End Function

Observe então que foram acrescentados call abreconexao(101010) e call fechaconexao

Curiosidade: observe que se for usar o DlookupX para popular campos (exemplo do formulário que se encontra no BD), não haverá necessidade de abrir conexão ou fechar conexao porque já é feito dentro do DlookupX, conforme alteração acima.

Sucesso e obrigado a todos que contribuiram!

Ah, outra alteração a ser feita é trocar o CURRENTDB para BD.

De:

Set rs = CurrentDb.OpenRecordset(strSQL, 4)

para:

call abreconexao(101010)
Set rs = bd.OpenRecordset(strSQL, 4)

Sucesso!

Grande Avelino,

Parabéns pela iniciativa.

Pessoas como você engrandecem este maravilhoso Fórum.

Vou testar suas funções, que pelo visto estão ótimas.

Abraço!

Sds,

Opa, Avelino,
Quer dizer que quando precisar abriar a conexao basta chamar
a função abreconexao(101010) e setar o recordset que pretendo
abrir?

Opa, Marcelo.

Isso mesmo! E observe que toda função de escopo PUBLIC deve receber uma "chave" de segurança. No caso coloquei 101010 mas vc deve mudar para um número que vc achar seguro.

Todas as minhas funções públicas agora levam uma chave de segurança no seu argumento, para evitarmos que o invalor execute a função pela "janela imediata" do VBA.


Charles,

fico muito agradecido pelo seu apoio e participação.

Sucesso!

Ola.
Apenas para pegar o gancho do tópico, utilizei o conceito do avelino do modulo de conexão e fiz algumas brincadeiras aqui de teste.

Por exemplo, povoar uma combox.


Sub PovoarCombox() 'Aqui vai o nome da combox que voce quizer
Dim Rs As DAO.Recordset
Call abreconexao(101010)
Set Rs = bd.OpenRecordset("SELECT Id,Descricao FROM SuaTabela ORDER BY Id;")

Me.TxtCombox.RowSourceType = "Value List"
Me.TxtCombox.ColumnCount = 2
Me.TxtCombox.ColumnWidths = "1cm;8cm"
Me.TxtCombox.RowSource = ""
Me.TxtCombox.Requery

Do Until Rs.EOF
Me.TxtCombox.AddItem Rs.Fields("Id") & ";" & Rs.Fields("Descricao ")
Rs.MoveNext
Loop


Set Rs = Nothing
DoCmd.Hourglass False
End Sub


Depois no Evento ao Carregar o Form utilize
PovoarCombox


Tambem utilizei para gravar registros na tabelas

Algo assim:

Dim rst As DAO.Recordset
Call abreconexao(101010)
Set rst = bd.OpenRecordset("SELECT * FROM SuaTabela", 2, dbAppendOnly)
With rst
.AddNew

!Campo1= Txt1
!Campo2_CentroCusto = Txt2
!Campo3_NomeArea = Txt3

.Update
.Close
End With
A = MsgBox("Registrado com sucesso.", vbInformation, "Confirmação!")
Call fechaconexao
DoCmd.Close


Ainda nao testei para relatorios e consultas, mas vou testar durtante a semana
Bom fica ai a dica


At+

Avelino, bom dia!
me deparei com um erro bem interessante, quando uso o Dlookup com o seu controle de Usuários e Permissões, quando da acesso Bloqueado o DLookUp entende como erro e não trata o código para fechar o banco, e então o BE continua aberto e ele não chama o Call fechaconexao.

esta certo esta minha teoria?

Código:

Public Function DLookupX(NomeCampo As Variant, nomeTabela As Variant, Optional filtro As String = "") As Variant
Dim Rs As DAO.Recordset
On Error GoTo trataerro
Dim strSQL As String
strSQL = "Select (" & NomeCampo & ") AS k FROM " & nomeTabela & IIf(filtro = "", ";", " WHERE " & filtro & ";")
Call acx
Set Rs = Db.OpenRecordset(strSQL, 4)
DLookupX = Rs!k
Rs.Close: Set Rs = Nothing
sair:
    Call fcx
    Exit Function
trataerro:
Select Case Err.Number
    Case 3061: msgbox "DLookupX - Campo inexistente...", vbInformation, "Aviso"
    Case 3031: msgbox "DLookupX - Conexão fechada com a base de dados...", vbInformation, "Aviso"
    Case 3078: msgbox "DlookupX - Tabela inexistente...", vbInformation, "Aviso"
    Case 3464: msgbox "DlookupX - Tipos de dados incopatíveis...", vbInformation, "Aviso"
    Case 3021: DLookupX = Null
    Case Else
        msgbox "DLookupX - " & Err.Description & " Nº: " & Err.Number
End Select
End Function

Código:

Public Function fncPermissões(NomeForm As Form)
Dim filtro As String
On Error Resume Next
filtro = "objeto = '" & NomeForm.Name & "'"
filtro = "Idfuncao = " & Nz(DLookupX("idFuncao", "tblFunções", filtro), 0) & " AND idUsuario =" & login.ID

If Nz(DLookupX("bloqueada", "tblpermissõesUsuários", filtro), True) = True Or login.ID = 0 Then
    msgbox "Acesso bloqueado...", vbInformation, "Aviso"
    DoCmd.Close acForm, NomeForm.Name
    Exit Function
End If
NomeForm.AllowEdits = Nz(DLookupX("atualizar", "tblpermissõesUsuários", filtro), "false")
NomeForm.AllowDeletions = Nz(DLookupX("excluir", "tblpermissõesUsuários", filtro), "false")
NomeForm.AllowAdditions = Nz(DLookupX("inserir", "tblpermissõesUsuários", filtro), "false")

End Function

Para resolver o caso só acrescentar o Call fcx(fecha conexão) na ultima linha antes de fechar a função ficando desta maneira:

Código:

Public Function DLookupX(NomeCampo As Variant, nomeTabela As Variant, Optional filtro As String = "") As Variant
Dim Rs As DAO.Recordset
On Error GoTo trataerro
Dim strSQL As String
strSQL = "Select (" & NomeCampo & ") AS k FROM " & nomeTabela & IIf(filtro = "", ";", " WHERE " & filtro & ";")
Call acx
Set Rs = Db.OpenRecordset(strSQL, 4)
DLookupX = Rs!k
Rs.Close: Set Rs = Nothing
sair:
    Call fcx
    Exit Function
trataerro:
Select Case Err.Number
    Case 3061: msgbox "DLookupX - Campo inexistente...", vbInformation, "Aviso"
    Case 3031: msgbox "DLookupX - Conexão fechada com a base de dados...", vbInformation, "Aviso"
    Case 3078: msgbox "DlookupX - Tabela inexistente...", vbInformation, "Aviso"
    Case 3464: msgbox "DlookupX - Tipos de dados incopatíveis...", vbInformation, "Aviso"
    Case 3021: DLookupX = Null
    Case Else
        msgbox "DLookupX - " & Err.Description & " Nº: " & Err.Number
End Select
Call fcx
End Function

Parabéns Avelino, estou usando com MySQL e fazendo algumas adaptações ficou perfeito, agora consigo trabalhar totalmente desvinculado com o MySQL!

Obrigado por contribuir!

Bom Dia ass gostaria de saber qual a versão do Mysql que está a usar porque a versão que estou a usar não suporte a função DLookup a versão 6.0

Bom dia Avelino João, se a gente puder trocar algumas figurinhas vai ser legal, vi que vc esta usando stored procedures para carregar formulário continuo desvinculado com o MySQL, e eu estou apanhando um pouco, posso te enviar um email?

Sobre a sua pergunta, estou usando atualmente 5.1, e o que eu fiz foi adaptar as funções do Avelino pra buscar direto por ADO, veja a função DlookupX:

Public Function DlookupX(NomeCampo As Variant, nomeTabela As Variant, Optional filtro As String = "") As Variant
On Error GoTo trataerro
Dim strSQL As String
strSQL = "select (" & NomeCampo & ") as k from " & nomeTabela & IIf(filtro = "", ";", " where " & filtro & ";")
'AQUI JÁ TENHO MINHA CONEXÃO EM UM MÓDULO GLOBAL ABRINDO A BASE
ConLD (strSQL)
'AQUI PASSO OS DADOS DO RECORDSET
DlookupX = rsD!k
sair:
   Exit Function
trataerro:
Select Case Err.Number
   Case 3061: MsgBox "DLookupX - Campo inexistente...", vbInformation, NomeAplicativo
   Case 3031: MsgBox "DLookupX - Conexão fechada com a base de dados...", vbInformation, NomeAplicativo
   Case 3078: MsgBox "DlookupX - Tabela inexistente...", vbInformation, NomeAplicativo
   Case 3464: MsgBox "DlookupX - Tipos de dados incopatíveis...", vbInformation, NomeAplicativo
   Case 3021: DlookupX = Null
   Case Else
           MsgBox "Ocorreu um erro na aplicação." & vbCr & "Relate os dados abaixo ao suporte." & vbCr & _
          "Erro Nº: " & Err.Number & vbCr & _
          "Descrição do erro: " & Err.Description & vbCr & _
          "Módulo: modFuncoesD" & vbCr & _
          "Procedimento: DlookupX", vbExclamation, NomeAplicativo
End Select
End Function

A maior mudança foi no DFirstX e DLastX que não existem no MySQL, sendo assim mando ele ordenar pelo campo de busca ASC (quando for DFirstX) ou por DESC (quando for DLastX), limitando apenas a 1 registro, veja como ficou o DFirstX:

Public Function DFirstX(NomeCampo As Variant, nomeTabela As Variant, Optional filtro As String = "") As Variant
On Error GoTo trataerro
Dim strSQL As String
strSQL = "select " & NomeCampo & " as k from " & nomeTabela & IIf(filtro = "", "", " where " & filtro) & _
" order by " & NomeCampo & " asc limit 1"
'AQUI JÁ TENHO MINHA CONEXÃO EM UM MÓDULO GLOBAL ABRINDO A BASE
ConLD (strSQL)
'AQUI PASSO OS DADOS DO RECORDSET
DFirstX = rsD!k
sair:
   Exit Function
trataerro:
Select Case Err.Number
   Case 3061: MsgBox "DfirstX - Campo inexistente...", vbInformation, NomeAplicativo
   Case 3031: MsgBox "DfirstX - Conexão fechada com a base de dados...", vbInformation, NomeAplicativo
   Case 3078: MsgBox "DfirstX - Tabela inexistente...", vbInformation, NomeAplicativo
   Case 3464: MsgBox "DfirstX - Tipos de dados incopatíveis...", vbInformation, NomeAplicativo
   Case 3021: DFirstX = Null
   Case Else
           MsgBox "Ocorreu um erro na aplicação." & vbCr & "Relate os dados abaixo ao suporte." & vbCr & _
          "Erro Nº: " & Err.Number & vbCr & _
          "Descrição do erro: " & Err.Description & vbCr & _
          "Módulo: modFuncoesD" & vbCr & _
          "Procedimento: DFirstX", vbExclamation, NomeAplicativo
End Select
End Function

Boa Tarde ass ok podemos sim trocar informação manda um email para avelino008@hotmail.com

Amigos havia um erro no meu DlookupX, do jeito que estava eu não conseguia buscar mais de um campo na base, veja como ficou:


Public Function DlookupX(NomeCampo As Variant, nomeTabela As Variant, Optional filtro As String = "") As Variant
On Error GoTo trataerro
Dim strsql As String
strsql = "select concat_ws('#'," & NomeCampo & ") as k from " & nomeTabela & IIf(filtro = "", ";", " where " & filtro & ";")
ConLD (strsql)
DlookupX = rsD!k
sair:
Exit Function
trataerro:
Select Case Err.Number
Case 3061: MsgBox "DLookupX - Campo inexistente...", vbInformation, NomeAplicativo
Case 3031: MsgBox "DLookupX - Conexão fechada com a base de dados...", vbInformation, NomeAplicativo
Case 3078: MsgBox "DlookupX - Tabela inexistente...", vbInformation, NomeAplicativo
Case 3464: MsgBox "DlookupX - Tipos de dados incopatíveis...", vbInformation, NomeAplicativo
Case 3021: DlookupX = Null
Case Else
MsgBox "Ocorreu um erro na aplicação." & vbCr & "Relate os dados abaixo ao suporte." & vbCr & _
"Erro Nº: " & Err.Number & vbCr & _
"Descrição do erro: " & Err.Description & vbCr & _
"Módulo: modFuncoesD" & vbCr & _
"Procedimento: DlookupX", vbExclamation, NomeAplicativo
End Select
End Function


Adicionei o concat_ws pois consigo definir o campo que vai ser usado para concatenar, ao chamar a função faço o seguinte:

dim str as string
str = dlookupx("codigo,rzsocial,fantasia","tblX")

a função vai me retornar "CODIGO DO CLIENTE#RZ. SOCIAL DO CLIENTE#FANTASIA DO CLIENTE"