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:
| Field Name | Data Type |
| sql_id | long |
| sql_wording | text 255 |
| column_name | text 50 |
| column_heading | text 50 |
| field_name | text 50 |
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.
