Knocked up this morning, so it's pretty rough.
e.g. It doesn't check that the queries are actually select queries and I'm
sure there are a bunch of bugs in it.
' PersistQueries: Allows you to persist all open queries to tables
' ClearTmpTables: Removes all temp tables created by PersistQueries
Option Compare Database
Option Explicit
Private Declare Function EnumChildWindows _
Lib "user32" (ByVal hWndParent As Long, _
ByVal lpEnumFunc As Long, _
ByVal lParam As Any) As Long
Private Declare Function GetWindowText _
Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long
Private Declare Function GetTopWindow _
Lib "user32" ( _
ByVal hwnd As Long _
) As Long
Private Declare Function GetWindow _
Lib "user32" ( _
ByVal hwnd As Long, ByVal wCmd As Long _
) As Long
Private Declare Function GetClassName _
Lib "user32" Alias "GetClassNameA" ( _
ByVal hwnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long _
) As Long
' *************************************
'
Function PersistQueries() As String
Dim colQueries As Collection
Dim varValue As Variant
Set colQueries = EnumChild
For Each varValue In colQueries
Call PersistQry(Trim(Left(varValue(1), InStr(varValue(1), ":") - 1)))
Next
End Function
Function ClearTmpTables()
Dim intCount As Integer
Dim loTab As DAO.TableDef
Dim loProp As DAO.Property
Dim db As DAO.Database
Dim strTab As String
Set db = CurrentDb
For intCount = db.TableDefs.Count - 1 To 0 Step -1
Set loTab = db.TableDefs(intCount)
For Each loProp In loTab.Properties
If loProp.Name = "Temp" Then
If loProp.Value = True Then
On Error Resume Next
db.Execute "DROP TABLE " & loTab.Name
On Error GoTo 0
End If
End If
Next
Next
Set loTab = Nothing
Set db = Nothing
End Function
Private Sub PersistQry(strQDF As String)
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim loTab As DAO.TableDef
Dim strSQl As String
Dim strTab As String
Dim varSQL As Variant
Const SQL_INTO = " INTO "
Const SQL_FROM1 = vbCrLf & "FROM "
Const SQL_FROM2 = " FROM "
Set db = CurrentDb
Set qdf = db.QueryDefs(strQDF)
strSQl = qdf.SQL
qdf.Close
Set qdf = Nothing
strTab = "tmp_" & Hex(CLng(Time * 10 ^ 7)) & "_" & strQDF
If InStr(1, strSQl, SQL_FROM1, vbTextCompare) 0 Then
varSQL = Split(strSQl, SQL_FROM1)
strSQl = varSQL(0) & SQL_INTO & strTab & SQL_FROM1 & varSQL(1)
ElseIf InStr(1, strSQl, SQL_FROM2, vbTextCompare) 0 Then
varSQL = Split(strSQl, SQL_FROM2)
strSQl = varSQL(0) & SQL_INTO & strTab & SQL_FROM2 & varSQL(1)
End If
db.Execute strSQl
Set loTab = db.TableDefs(strTab)
With loTab
.Properties.Append .CreateProperty("Temp", dbBoolean, True, False)
End With
Set loTab = Nothing
Set db = Nothing
DoCmd.OpenTable strTab, acViewNormal, acReadOnly
End Sub
Function EnumChild() As Collection
Dim varItem As Variant
Dim colChildWins As Collection
Dim intCount As Integer
Const WIN_CLASS_QUERY = "OQry"
Set colChildWins = New Collection
Call EnumChildWindows(hWndAccessApp, AddressOf EnumWindowsProc,
colChildWins)
For intCount = colChildWins.Count To 1 Step -1
varItem = colChildWins(intCount)
If varItem(2) <WIN_CLASS_QUERY Then
colChildWins.Remove intCount
End If
Next
Set EnumChild = colChildWins
End Function
Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Collection) As
Long
Dim lpString As String, cch As Long
Dim lpClassName As String, nMaxCount As Long
Dim lngret As Long
Dim cWI As Variant
cch = 260
lpString = String(cch, 0)
lngret = GetWindowText(hwnd, lpString, cch)
If lngret 0 Then
lpString = Left(lpString, lngret)
nMaxCount = 260
lpClassName = Space(nMaxCount)
lngret = GetClassName(hwnd, lpClassName, nMaxCount)
lpClassName = Left(lpClassName, lngret)
cWI = Array(hwnd, lpString, lpClassName)
lParam.Add cWI
End If
EnumWindowsProc = True
End Function
--
Terry Kreft
<pi********@hotmail.comwrote in message
news:11**********************@m73g2000cwd.googlegr oups.com...
>
Terry Kreft wrote:
No, not natively, you would have to persist the resultset somewhere and
then
switch to design view.
Terry,
do you have a quick example of doing that?
thanks,
Pieter
