Esta es una conversación privada entre McPegasus y Buho sobre el tema de consultas
en una MDB
Primero:
¿Como crear una consulta permanente en una MDB?
===============================================
Buho:
'Proposito. Crear una consulta permanente en una base de datos
'Este codigo se puede ejecutar desde otra MDB completamente ajena
'a la MDB donde se dese crear la consulta.
'Debe recibir como parametros, el nombre de la consulta y la instruccion SQL
'que deseamos que se convierta en consulta permamente
Option Compare Database
Option Explicit
Function CreaNuevaConsulta(Name As String, Sql As String)
Dim dbs As Database
Dim qdfNuevo As QueryDef
'est si deseamos crearla en una base de datos ajena a esta que corre el codigo
Set dbs = OpenDatabase("C:\Twpac\dsystem.Mdb")
'esto si deseamos crearla en la propia MDB que corre el codigo
'Set Dbs= CurrentDb()
With dbs
' Crea una consulta permanente.
Set qdfNuevo = .CreateQueryDef(Name, Sql)
.Close
End With
End Function
MCPEGASUS lo simplifica:
Call CurrentDb.CreateQueryDef(strNombreQuery, strSql)
y para borrar
CurrentDb.QueryDefs.Delete (strNombreQuery)
Luego surgió como recorrer todas las consultas y grabarlas, por ejemplo en un combo
Búho dió estas Tres soluciones:
(A)
Sub DameConsultas()
Dim ObjetoConsulta As AccessObject, Dbs As Object
Set dbs = Application.CurrentData
For Each ObjetoConsulta In dbs.AllQueries
Debug.Print ObjetoConsulta.Name
'aqui carga en el combo con Additem el nombre
Next ObjetoConsulta
End Sub
Pero esta que hemos visto no funciona en Access 97, así que ponemos esta otra
que si funciona para Access 97:
(B) Para Access 97
Sub OtraConDAO_Access97()
Dim VarConsultas As QueryDef
With CurrentDb
For Each VarConsultas In .QueryDefs
Debug.Print " " & VarConsultas.Name
Next VarConsultas
.Close
End With
End Sub
Ojo a estas ultimas para Acces97 (En Access >2000 no ocurre este problema)
Hay que filtrar las consultas que empiezan por "~sq_", estas son las
consultas que se hacen dentro de controles de formularios e informes.
(C)
Private Function ListaQueries(Campo As Control, Id As Long, fila As Long, col As Long, código As Integer)
Dim DescuentA As Integer, zx As Integer
Static dbs(127), Entradas
Dim ValRetorno
ValRetorno = Null
Select Case código
Case LB_INITIALIZE 'Inicializar.
Dim MIDB As Database, micontenedor As Container
Set MIDB = CurrentDb()
Entradas = MIDB.QueryDefs.Count
DescuentA = 0
For zx = 0 To Entradas - 1
'If (midb.QueryDefs(zx).Attributes And DB_SYSTEMOBJECT) Or midb.TableDefs(zx).Name Like "MSys*" Then
If (MIDB.QueryDefs(zx).Name Like "MSys*") Or (MIDB.QueryDefs(zx).Name Like "~*") Then
DescuentA = DescuentA + 1
Else
dbs(zx - DescuentA) = MIDB.QueryDefs(zx).Name
End If
Next zx
Entradas = Entradas - DescuentA
Me.NUmeroConsultas.Caption = "Total " & Entradas & " consultas"
MIDB.Close
Set MIDB = Nothing
ValRetorno = Entradas
Case LB_OPEN 'Abrir.
ValRetorno = Timer 'ID único para control.
Case LB_GETROWCOUNT 'Número de filas.
ValRetorno = Entradas
Case LB_GETCOLUMNCOUNT 'Número de columnas.
ValRetorno = 1
Case LB_GETCOLUMNWIDTH 'Anchura de columna.
ValRetorno = -1 'Usar la anchura predeterminada.
Case LB_GETVALUE 'Obtener los datos.
ValRetorno = dbs(fila)
Case LB_END 'Terminar
For Entradas = 0 To 127
dbs(Entradas) = ""
Next
End Select
ListaQueries = ValRetorno
End Function
OBVIAMENTE SON MUCHO MAS SENCILLOS LOS DOS PRIMEROS METODOS
Otra cuestion sobre consultas:
McPegasus da una simple linea de codigo para ver si una consulta permamente existe en
una MDB
If Not IsNull(DLookup("Name", "MSysObjects", "Name = '" & strNombreQuery & "'")) Then
mcBuscarConsulta = DLookup("Name", "MSysObjects", "Name = '" & strNombreQuery & "'")
End If
               (
geocities.com/es/ensolva/Descargas)                   (
geocities.com/es/ensolva)                   (
geocities.com/es)