[AccessD] Reports

Max Wanadoo max.wanadoo at gmail.com
Fri May 30 10:29:10 CDT 2008


Edward,
I just wrote some code to create a flat file from the separate records
(denormalize it all).
Then created the report labels from that.
I have posted the code below but it is nothing to should home about.
Cannot provide any data however, as it was a live system.
Max
 

Option Compare Database
Option Explicit

Public Function pfCreateTempTableForReport()
  Dim dbs As DAO.Database, rst As DAO.Recordset, sql As String, rst2 As
DAO.Recordset, sql2 As String
  Set dbs = CurrentDb
  Dim lngCt As Long, lngFor As Long, strFld As String, strNumb As String
  sql = "Drop Table tblTemp"
  On Error Resume Next
  dbs.Execute (sql)
  On Error GoTo errhandler:
  sql = "Create Table tblTemp (UCAS_NBR_AND_CH Text, LAST Text, Initial
Text,"
  strFld = "CHOICE_TYPE"
  For lngFor = 1 To 6
    sql = sql & strFld & lngFor & " Text,"
  Next lngFor
  strFld = "COURSE"
  For lngFor = 1 To 6
    sql = sql & strFld & lngFor & " Text,"
  Next lngFor
  strFld = "DR"
  For lngFor = 1 To 6
    sql = sql & strFld & lngFor & " Text,"
  Next lngFor
  sql = Left(sql, Len(sql) - 1) & ")"
  dbs.Execute (sql)

  ' get the data
  sql = "Select * from ExampleData order by UCAS_NBR_AND_CH"
  Set rst = dbs.OpenRecordset(sql)
  rst.MoveFirst
  Do While Not rst.EOF
    sql2 = "Select * from tblTemp WHERE UCAS_NBR_AND_CH='" &
rst!UCAS_NBR_AND_CH & "'"
    Set rst2 = dbs.OpenRecordset(sql2)
    If rst2.EOF Then
      rst2.AddNew
      rst2!UCAS_NBR_AND_CH = Nz(rst!UCAS_NBR_AND_CH, "")
      rst2!last = rst!last
      rst2!Initial = rst!Initial
      lngCt = 1
    Else
      lngCt = lngCt + 1
      If lngCt > 6 Then Stop
      rst2.Edit
    End If
    strFld = "CHOICE_TYPE"
    rst2(strFld & lngCt) = Trim(rst(strFld) & " " & rst!Field12)
    strFld = "COURSE"
    rst2(strFld & lngCt) = Trim(rst(strFld))
    strFld = "DR"
    rst2(strFld & lngCt) = Trim(rst(strFld))
    rst2.Update
    rst.MoveNext
  Loop
  MsgBox "Done"
exithere:
  Set dbs = Nothing: Set rst = Nothing: Set rst2 = Nothing
  Exit Function
errhandler:
  MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
  Resume exithere
End Function




-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Edward S Zuris
Sent: Friday, May 30, 2008 5:16 PM
To: accessd at databaseadvisors.com
Subject: Re: [AccessD] Reports


 Gee, but what was the answer to the Reports question ?





More information about the AccessD mailing list