Well... we have the table and the column headings are properly sorted
by session! BUT... there's no data in it. I received no new
messages while running the procedure (just the "DROP TABLE" and
"CREATE TABLE" messages).
I should tell you that after changing the "rs" variable name to
"rsSessions" per your previous instructions, I received two more
variable error messages in the following lines:
' all well, tidy up
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
I figured that I should change these to "rsSessions" too, and I did.
The variable error messages stopped, but I thought you should know
just in case I wasn't supposed to do that.
Incidentally, from your last post you seem to have a stray line in there:
if you see these here, they should be deleted:
'okay, run the command
db.Execute strSQL, dbFailOnError
I deleted this line.
Remember about those fingers this time!
I did remember, but will also include the toes next time! Ha!
Again, I have pasted the current version of the code below.
Many, many thanks!
Jessi
____________________________
Option Compare Database
' this line forces VBA to check the existence of all the variables
Option Explicit
'This is a little test program just to get into things:
Public Sub TryThis()
'"dim" statements let VBA know what variables we need
'we are using DAO so make sure it is checked in Tools...References
'
Dim db As DAO.Database ' handle to the database engine
Dim strSQL As String ' a SQL command
'"const" statments are convenient ways to handle names etc.
'that might change but usually don't
Const c_strTempTable As String = "t_tblWeeklySchedule"
'set up the handles
Set db = CurrentDb()
'check if there is already a temp table
If TableExists(c_strTempTable) Then
'get rid of it
strSQL = "DROP TABLE " & c_strTempTable
'remove this line once we are happy it's working
MsgBox strSQL
'carry it out
'dbFailOnError makes an error if there was a problem with the SQL
db.Execute strSQL, dbFailOnError
End If
' Call a proc to create the new table
MakeTempTable c_strTempTable
End Sub
'Quick function to see if the table already exists
Private Function TableExists( _
TableName As String) As Boolean
'dim statements as above
Dim db As Database
Dim tdf As TableDef
'set up handles
Set db = CurrentDb()
'don't respond to the error
On Error Resume Next
'this will cause an error if the table does not exist
Set tdf = db.Tabledefs(TableName)
'now see if there _was_ an error
If Err.Number = 0 Then
'okay: the table was there
TableExists = True
Else
'not okay, it wasn't there
TableExists = False
End If
End Function
' Create a new temp table using columns from the SessionLookup table
'
Private Sub MakeTempTable(NewTableName As String)
' variables
Dim db As Database ' current db
Dim strSQL As String ' make a command
Dim rsSessions As Recordset ' sessionlookup table
' Handle to current database
Set db = CurrentDb()
' Get the sessions
strSQL = "SELECT fldSessionLookUp " & vbNewLine & _
"FROM tblSessionLookup" & vbNewLine & _
"ORDER BY fldSessionSortNo;"
' it's a ForwardOnly snapshot because it's fastest
Set rsSessions = db.OpenRecordset( _
strSQL, dbOpenSnapshot, dbForwardOnly)
' Now we start the new table
strSQL = "CREATE TABLE " & NewTableName & vbNewLine & _
"( fldResidentID LONG CONSTRAINT pk PRIMARY KEY"
' Add a column for every line in tblSessionLookup
Do While Not rsSessions.EOF
strSQL = strSQL & "," & vbNewLine & _
" " & rsSessions!fldSessionLookUp & " TEXT(1)"
' move to next one
rsSessions.MoveNext
Loop
' complete the command
strSQL = strSQL & ");"
' delete this too when it's all working: not for a while!!
MsgBox strSQL
' and try running it
db.Execute strSQL, dbFailOnError
' all well, tidy up
rsSessions.Close
Set rsSessions = Nothing
Set db = Nothing
End Sub
' Read the DailySessions table and de-normalise it to
' get the weekly schedule for each resident
'
Public Sub FillTempTable(NewTableName As String)
' variables as usual
Dim db As Database ' currentdb
Dim rsDS As Recordset ' old DailySessions
Dim rsTT As Recordset ' new TempTable
Dim strSQL As String
' start as usual
Set db = CurrentDb()
' we need all the session allocations in order of resident
' and then by time of week
' Thinking about it, this could just be a querydef, but let's
' keep going for now
strSQL = "SELECT ds.fldDS_ResidentID, " & vbNewLine & _
"ds.fldDS_SessionTime, " & vbNewLine & _
"ds.fldDS_WorksiteID " & vbNewLine & _
"FROM tblDailySessions AS ds " & vbNewLine & _
" LEFT JOIN tblSessionLookup AS sl " & vbNewLine & _
" ON ds.fldDS_SessionTime = " & vbNewLine & _
" sl.fldSessionLookup " & vbNewLine & _
"ORDER BY ds.fldDS_ResidentID, " & vbNewLine & _
" sl.fldSessionSortNo; "
' this is another information window!
MsgBox strSQL
' get the recordset
Set rsDS = db.OpenRecordset(strSQL, dbOpenSnapshot, dbForwardOnly)
' open the new table
strSQL = "SELECT * FROM " & NewTableName & " WHERE FALSE;"
Set rsTT = db.OpenRecordset(strSQL, dbOpenDynaset)
' now go round each resident: outer loop
Do While Not rsDS.EOF
' create a new temp record and mark it with the resident
rsTT.AddNew
rsTT!fldResidentID = rsDS!fldDS_ResidentID
' go round each timeslot and put it in
' complex exit strategy needs to be done in order
Do While True
' end of input recordset: quit now
If rsDS.EOF Then Exit Do
' it's a different resident: finished with this temp record
If rsDS!fldDS_ResidentID <> rsTT!fldResidentID Then Exit Do
' okay, copy the worksite to the correct column
rsTT.Fields(rsDS!fldDS_SessionTime) = rsDS!fldDS_WorksiteID
' move to next daily session record
rsDS.MoveNext
Loop
' we have to save the temp record
rsTT.Update
' and go round again: we'll drop out of the top of the
' loop if that was the last resident.
Loop
rsTT.Close
rsDS.Close
' finished
End Sub
