Create flexible Excel exports with on-the-fly SQL

Kingsway Financial Assessments provides independent financial assessment reports and credit reports to support decision making when awarding contracts and tenders. Kingsway uses an Access database built by Hockley Computer Services using Goldsoft. Ken Hockley is today's guest blogger.

I’ve been using SQL statements in temporary Access tables to extract data to Excel for some time now (simple data dump).

The client has a form which shows a selection of the tables and fields in their system. In this example, the fields come from the main table t_job and related tables. The client selects which fields they want in the output file, and set some other parameters such as from date, to date, customer name, state, etc.

The client can choose any columns they wish. In the example that follows, the client is comparing certain pieces of financial data of a number of companies that they are evaluating. They only want to compare a subset of the data from the balance sheet and the profit and loss statement--they don’t want to see all the columns.

Once the client makes his selections, a VBA procedure writes all the SQL commands into a temp table named t_temp_sql, as shown here:

This might be kind of hard to read, so the table design looks like this:

The SQL statements in the sql_wording field are constructed from parts that are stored in an Excel workbook named Data_template_1.xls:

Based on the selections the client has made, the first part of the VBA procedure loops through this worksheet and uses the data to create the SQL statements and store them in the the Access temp table t_temp_sql.

The second part of the VBA procedure (starting with the comment "EXPORT PROCESS") loops through the Access temp table t_temp_sql and evaluates each of the SQL statements. It then populates an empty Excel sheet named raw_template.xls with the results and saves it as data_dump.xls, which is then sent to the client. (Apologies for the line wraps in the code—that's the only way to make it fit in this column.)

Private Sub dump_data()
  On Error GoTo e1
  
  'PURPOSE - dump data from fields in t_job and related tables to Excel
  'for further analysis
  
  Dim curr_db As Database
  Dim rs_sql As Recordset
  Dim rs_job As Recordset
  Dim rs_test As Recordset
  Dim file_name As Variant
  Dim hold_column_prefix As Variant
  Dim hold_sql As Variant
  Dim hold_crit As Variant
  Dim template_path As Variant
  Dim export_path As Variant
  Dim xlapp As Excel.Application
  Dim xlworkbook As Excel.Workbook
  Dim xlworksheet As Excel.Worksheet
  Dim xlrange As Excel.Range
  Dim screen_row As Long
  Dim num_of_jobs As Long
  Dim curr_job As Long
  Dim num_of_recs As Long
  Dim curr_rec As Long
  Dim c As Integer
  Dim num_of_sql_commands As Long
  Dim screen_col As String
  
  Set curr_db = DBEngine.Workspaces(0).Databases(0)
  
  'open an excel session
  Set xlapp = New Excel.Application
  
  'clear the temp table which will hold the sql commands
  hold_crit = "DELETE t_temp_sql.sql_id FROM t_temp_sql"
  DoCmd.RunSQL hold_crit
  
  'open a rs_on the empty temp table
  hold_crit = "select * from t_temp_sql"
  Set rs_sql = curr_db.OpenRecordset(hold_crit)
  
  'this file holds the specifications for the import
  template_path = "h:\job\production\data_templates\"
  file_name = "data_dump_financials.xls"
  
  'open the template Excel file
  Set xlworkbook = xlapp.Workbooks.Open(template_path & file_name)
  Set xlworksheet = xlworkbook.Worksheets(1)
  screen_row = 1     'row on excel sheet to start reading
  num_of_sql_commands = 1  'used to keep commands in a logical order
  
  'open a rs on the main table "t_job" in this case
  'use an on screen filter here to restrict the number of records
  'for analysis by date, client name, area etc
  hold_crit = "select * from t_job where job_id >= 14511 and job_id <= 14513"
  Set rs_job = curr_db.OpenRecordset(hold_crit)
  If rs_job.RecordCount > 0 Then
     rs_job.MoveLast
     num_of_jobs = rs_job.RecordCount
     rs_job.MoveFirst
     curr_job = 0
     While curr_job < num_of_jobs
       'write the job number in to the temp table on an otherwise empty record
       rs_sql.AddNew
       rs_sql!sql_id = num_of_sql_commands
       rs_sql!sql_wording = rs_job!job_id
       rs_sql.Update
       'loop through each populated column in the worksheet
       screen_col = "c"   'column on excel sheet to start reading
       hold_column_prefix = ""   'use this variable to allow for columns after z
       While xlworksheet.Range(hold_column_prefix & screen_col & Format("1")) <> ""
         'add an sql line
         rs_sql.AddNew
         num_of_sql_commands = num_of_sql_commands + 1
         rs_sql!sql_id = num_of_sql_commands
         'construct the sql command
         hold_sql = "select " & xlworksheet.Range(hold_column_prefix & screen_col _
            & "2")
         hold_sql = hold_sql & " from " & xlworksheet.Range(hold_column_prefix & _
            screen_col & "1")
         hold_sql = hold_sql & " where " & xlworksheet.Range(hold_column_prefix & _
            screen_col & "5")
         hold_sql = hold_sql & " = " & _
            rs_job.Fields(xlworksheet.Range(hold_column_prefix & screen_col & "5"))
         rs_sql!sql_wording = hold_sql
         rs_sql!column_name = _
            xlworksheet.Range(hold_column_prefix & screen_col & "4")
         rs_sql!column_heading = _
            xlworksheet.Range(hold_column_prefix & screen_col & "3")
         rs_sql!field_name = _
            xlworksheet.Range(hold_column_prefix & screen_col & "2")
         rs_sql.Update
         'move to the next column
         c = Asc(screen_col)
         If c = 122 Then
            c = 96
            If hold_column_prefix = "a" Then hold_column_prefix = "b"
            If hold_column_prefix = "" Then hold_column_prefix = "a"
            'allows for columns up to bz but can easily be extended
         End If
         screen_col = Chr(c + 1)
       Wend
       rs_job.MoveNext
       curr_job = curr_job + 1
     Wend
  End If
  rs_job.Close
  rs_sql.Close
  
  Set xlworksheet = Nothing
  xlworkbook.Close False
  Set xlworkbook = Nothing
  
  'EXPORT PROCESS
  
  'execute all the sql commands in t_temp_sql to the output template
  file_name = "raw_file.xls"
  Set xlworkbook = xlapp.Workbooks.Open(template_path & file_name)
  Set xlworksheet = xlworkbook.Worksheets(1)
  screen_row = 0
  
  'open a rs_on the temp table
  hold_crit = "select * from t_temp_sql order by sql_id"
  Set rs_sql = curr_db.OpenRecordset(hold_crit)
  If rs_sql.RecordCount > 0 Then
     rs_sql.MoveLast
     num_of_recs = rs_sql.RecordCount
     curr_rec = 0
     rs_sql.MoveFirst
     While curr_rec < num_of_recs
       'a new job starts where t_temp_sql.column name is null
       'the "if" allows for flexibility of more code here
       If IsNull(rs_sql!column_name) Then
          screen_row = screen_row + 1
          'write the job and column heading
          screen_col = "a"
          'write the column heading if this is the first record
          If curr_rec = 0 Then
             xlworksheet.Range(screen_col & "1") = "Job No"
          End If
          xlworksheet.Range(screen_col & screen_row + 1) = rs_sql!sql_wording
       End If
       'the "if" allows for flexibility of more code here
       If Not IsNull(rs_sql!column_name) Then
          'write the column heading if this is the first record
          If screen_row = 1 Then
             xlworksheet.Range(rs_sql!column_name & screen_row) = _
                rs_sql!column_heading
          End If
          'execute the sql command using a recordset.
          'allows more flexibility than docmd.slq
          Set rs_test = curr_db.OpenRecordset(rs_sql!sql_wording)
          'if data has been found write the data to the worksheet
          If rs_test.RecordCount > 0 Then
             xlworksheet.Range(rs_sql!column_name & screen_row + 1) = _
                rs_test.Fields(rs_sql!field_name)
          End If
          rs_test.Close
       End If
       curr_rec = curr_rec + 1
       rs_sql.MoveNext
     Wend
  End If
  rs_sql.Close
  
  export_path = "h:\temp\data_dump.xls"
  hold = Dir(export_path)
  If Len(hold) > 0 Then
     Kill export_path
  End If
  
  Set xlworksheet = Nothing
  xlworkbook.SaveAs (export_path)
  xlworkbook.Close False
  Set xlworkbook = Nothing
  
  Set xlapp = Nothing
  
  Me!working_now.Visible = False
  Me.Repaint
  
  hold = "The Excel file has been created"
  hold = hold & crlf & crlf & export_path
  MsgBox hold, 0, system_error
  
  Exit Sub
  
e1:
  MsgBox Error$, 0, system_error
  Err.Number = 0
  Resume

  
End Sub

This approach results in an easy-to-maintain, easy-to-use architecture that the client really appreciates. A stripped-down sample output file (data_dump.xls) is available here.