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

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"