SSWPD Table Data Capture and SSWPD Select Query Creation

[Dal Jeanis]

The question #13 was intended to find out the mechanism. Do you know how the transaction is received or perceived by Access?

Basically, what I'm looking at is this - if we can detect the incoming transaction, then we can clone the incoming information and route the clone to the combined table.



If not, then we need to detect table updates, and create some kind of trigger that copies the information. For example, every X minutes, we could check each table for updates and copy them over. Or, every X minutes, we could delete an archive table, rename the current combined table to archive, and combine all the tables again.

A UNION query can be created, and it's not difficult, but I suspect that the string length of the query is pushing it.

[rmoreno]

No. 15 minutes would do fine.

[Dal Jeanis]

Put this in a new module and run it. See if the output from debug.print looks like your table names, and how many there are.

Dim dbs As Database
Set dbs = CurrentDb
'define and open local unique TableName recordset and load to aTableName array
    Dim strSqlTN As String
    strSqlTN = "SELECT  MSysObjects.Name AS TableName " & _
               "FROM MSysObjects " & _ 
               "WHERE MSysObjects.Type = 1 " & _ 
               "AND MSysObjects.Name LIKE ""SSWPD*"""
    debug.print strSqlTN 

    Dim rstTN As Recordset
    Set rstTN = dbs.OpenRecordset(strSqlTN, dbOpenDynaset)
    
    'define aTableName array and variables used to load the array
       Dim aTableName(100) As String
       Dim limTN As Integer
       Dim xTN As Integer
      
    'get list of unique active table names and load to aTableName array
        limTN = 0
        rstTN.MoveFirst
        Do Until rstTN.EOF
            limTN = limTN + 1
            aTableName(limTN) = rstTN!TableName
            debug.print aTableName(limTN)
            rstTN.MoveNext
        Loop
    rstTN.Close
    debug.print limTN

[rmoreno]

I copied and pasted the code into a new module. It doesn't run. All I get is a single tone.

[Dal Jeanis]

1) I added two lines at the beginning to establish addressability. You'll need to put in the full path to your test db.
NOPE - change that line to

Set dbs = CurrentDb

2) I added a space between TableName and the close quote, and a debug.print so you can read the SQL for errors
3) On Access 2010, I'm getting "no authority to read MSysObjects", which is a problem... (no problem with CurrentDb)

[rmoreno]

OK. I must be doing something wrong. I guess I don't really know how to properly paste the code into a new module. It still doesn't run and all I get is a single tone.

[Dal Jeanis]

Copy this into a new module.
Then in the immediate window, type "Call george"

Sub george()
Dim dbs As Database
Set dbs = CurrentDb
'define and open local unique TableName recordset and load to aTableName array
    Dim strSqlTN As String
    strSqlTN = "SELECT  MSysObjects.Name AS TableName " & _
               "FROM MSysObjects " & _
               "WHERE MSysObjects.Type = 1 " & _
               "AND MSysObjects.Name LIKE ""SSWPD*"""
    Dim rstTN As Recordset
    Set rstTN = dbs.OpenRecordset(strSqlTN, dbOpenDynaset)
    
    'define aTableName array and variables used to load the array
       Dim aTableName(100) As String
       Dim limTN As Integer
       Dim xTN As Integer
      
    'get list of unique active table names and load to aTableName array
        limTN = 0
        rstTN.MoveFirst
        Do Until rstTN.EOF
            limTN = limTN + 1
            aTableName(limTN) = rstTN!TableName
            Debug.Print aTableName(limTN)
            rstTN.MoveNext
        Loop
    rstTN.Close
    Debug.Print limTN
   Dim txtSelectFieldsFrom As String
   Dim txtSqlUnion As String
   
   txtSelectFieldsFrom = "(SELECT " & _
    "Sample, NumRes, Datesave, Operator, Machine, " & _
    "User1, User2, User3, User4, User5, User6, " & _
    "Mean , Flags, User7, User8, User9, User10 FROM "
   txtSqlUnion = txtSelectFieldsFrom & aTableName(1) & ") "
   xTN = 2
   Do Until xTN > limTN
       txtSqlUnion = txtSqlUnion & "UNION " & txtSelectFieldsFrom & aTableName(xTN) & ") "
       xTN = xTN + 1
   Loop
   Debug.Print txtSqlUnion
End Sub

The very last line it prints out should be the query you need for your mass UNION.

[Dal Jeanis]

And, one more version, to add the table name. Be aware that if you copy it from the debug.print, you'll have to clean it up wherever it had a line break. however, that's the easiest you're going to get what you asked for, if a query this big will even run. It ran for the 20 tables on the test db you uploaded, so it works in theory, as long as it doesn't exceed 64K characters to the query - about 250 tables.

Sub george()
Dim dbs As Database
Set dbs = CurrentDb
'define and open local unique TableName recordset and load to aTableName array
    Dim strSqlTN As String
    strSqlTN = "SELECT  MSysObjects.Name AS TableName " & _
               "FROM MSysObjects " & _
               "WHERE MSysObjects.Type = 1 " & _
               "AND MSysObjects.Name LIKE ""SSWPD*"""
    Dim rstTN As Recordset
    Set rstTN = dbs.OpenRecordset(strSqlTN, dbOpenDynaset)
    
    'define aTableName array and variables used to load the array
       Dim aTableName(100) As String
       Dim limTN As Integer
       Dim xTN As Integer
      
    'get list of unique active table names and load to aTableName array
        limTN = 0
        rstTN.MoveFirst
        Do Until rstTN.EOF
            limTN = limTN + 1
            aTableName(limTN) = rstTN!TableName
            Debug.Print aTableName(limTN)
            rstTN.MoveNext
        Loop
    rstTN.Close
    Debug.Print limTN

   Dim txtFields As String
   Dim txtSqlUnion As String
   
   txtFields = """ AS TableName, " & _
    "Sample, NumRes, Datesave, Operator, Machine, " & _
    "User1, User2, User3, User4, User5, User6, " & _
    "Mean , Flags, User7, User8, User9, User10 FROM "

   txtSqlUnion = "(SELECT """ & aTableName(1) & txtFields & aTableName(1) & " ) "

   xTN = 2
   Do Until xTN > limTN
       txtSqlUnion = txtSqlUnion & "UNION (SELECT """ & aTableName(xTN) & txtFields & aTableName(xTN) & " ) "
       xTN = xTN + 1
   Loop
   Debug.Print txtSqlUnion
End Sub

[rmoreno]

OK. But I don't see where the tablename is included in the union query statement. What am I missing?

[Dal Jeanis]

beat ya by a half second!

[rmoreno]

It's telling me that txtFields is undefined.

[Dal Jeanis]

Change
Dim txtSelectFieldsFrom As String
to
Dim txtFields As String

[rmoreno]

Nice. This looks good. How do I call this module to create the query?

[Dal Jeanis]

The brute force method would have been to just keep the module in the database and run it in the immediate window whenever a new table was added. But, as long as I've gone this far, I might as well put some code in to turn it into an actual query and save it for you.

Public Sub CreateSSWPDUnion()On Error GoTo Err_CreateSSWPDUnion

    Dim dbs As Database
    Set dbs = CurrentDb

'define and open local unique TableName recordset and load to aTableName array
    Dim strSqlTN As String
    strSqlTN = "SELECT  MSysObjects.Name AS TableName " & _
               "FROM MSysObjects " & _
               "WHERE MSysObjects.Type = 1 " & _
               "AND MSysObjects.Name LIKE ""SSWPD*"""

    Dim rstTN As Recordset
    Set rstTN = dbs.OpenRecordset(strSqlTN, dbOpenDynaset)
    
    'define aTableName array and variables used to load the array
    Dim aTableName(100) As String
    Dim limTN As Integer
    Dim xTN As Integer
      
    'get list of unique active table names and load to aTableName array
    limTN = 0
    rstTN.MoveFirst
    Do Until rstTN.EOF
        limTN = limTN + 1
        aTableName(limTN) = rstTN!TableName
        'Debug.Print aTableName(limTN)
        rstTN.MoveNext
    Loop
    rstTN.Close
    'Debug.Print limTN

    Dim txtSelectFieldsFrom As String
    Dim txtSqlUnion As String
   
    txtFields = """ AS TableName, " & _
        "Sample, NumRes, Datesave, Operator, Machine, " & _
        "User1, User2, User3, User4, User5, User6, " & _
        "Mean , Flags, User7, User8, User9, User10 FROM "

    txtSqlUnion = "(SELECT """ & aTableName(1) & txtFields & aTableName(1) & " ) "
    xTN = 2
    Do Until xTN > limTN
        txtSqlUnion = txtSqlUnion & "UNION (SELECT """ & aTableName(xTN) & txtFields & aTableName(xTN) & " ) "
        xTN = xTN + 1
    Loop
    'Debug.Print txtSqlUnion

    Dim qdfNew As QueryDef
    Dim txtQryName As String

    txtQryName = "qry_SSWPD_All2"

' turn off errors for the delete
On Error Resume Next
     
    ' delete querydef if it exists
    dbs.QueryDefs.Delete (txtQryName)
 
' turn errors back on
On Error GoTo Err_CreateSSWPDUnion
    
    ' createquerydef command line follows
    Set qdfNew = dbs.CreateQueryDef(txtQryName, txtSqlUnion)
      
    dbs.Close

Exit_CreateSSWPDUnion:
    Exit Sub
    
Err_CreateSSWPDUnion:
    MsgBox Err.Description
    Resume Exit_CreateSSWPDUnion

End Sub

NOTE 1) Change the value of txtQryName to whatever you want the permanant query to be called.

NOTE 2) This code saves the query into the database, but the new query doesn't show up in the query window for me until I do something that refreshes that window.

NOTE 3) I added the keyword "Public" on the front, so you can call this subroutine from a macro or a button on a form if you want, or you can just call it in the immediate window.

NOTE 4) You can change the subroutine name to whatever you want with a global change.

NOTE 5) If you wanted the module to execute itself automatically whenever new tables are created, you could do some kind of magic like, each time it runs, save the number of tables currently being UNIONed, and checking occasionally whether there are still only that many tables. Something along those lines.

[rmoreno]

Good morning. Thanks for the code.
I pasted it into the module we have been working on. The "PUBLIC SUB CREATE...." text is all red. What does this mean?
When I try to execute the code all I get is a single tone.