Exporting a DB to XLS: It ignores formatting? - excel

Question

So I have a form that executes a VBA script via a macro. The purpose of said script is to open Excel, create a new workbook, gather information from several tables and export them to a formatted spreadsheet. Each person has a sheet with their name, and the relevant data is printed in said sheet. It works perfectly for the most part. Only one problem... The table in Access where the name and demographics data is gathered from is formatted to sort by last name ascending alphabetically. The VBA script exports it in the order the names were entered. I want my VBA script to respect the formatting in the database table, and I would prefer not to have to add an alphabetizing subroutine to my VBA script.
Table A Format: ID, Active, Last, First, Role, Traveler, Resident, Preceptee, Phone, Completion
Table B Format: ID, Course, Course ID, Offered, HLC, Course Type
Last in Table A called "Roster" is the field with which I want my VBA script to sort alphabetically. The database is already configured to do this.
Thanks in advance!
VBA Code:
Option Compare Database
' This module exports the database to a spreadsheet with specific formatting when called from a Macro
' Each Employee will have a sheet named thier last name which will contain all HLC modules they have completed in a list
' It is specific to this Database, but can be adapted to others.
' Version 1.0 Stable
Public Function ExportXLS(TblA As String, TblB As String, Optional names As String, Optional specific As Boolean)
'****************'
'Set up variables'
'****************'
Dim ctrA As Integer
Dim ctrB As Integer
Dim var As Long
Dim str As String
Dim excel As Object 'Pointer to Excel Application
Dim book As Object 'Pointer to Excel Workbook
Dim sheet As Object 'Pointer to Excell Sheet
Dim Roster As DAO.Recordset
Dim Course As DAO.Recordset
Dim Child As DAO.Recordset
Dim last_name As DAO.Recordset 'Matrix of pointers that will hold parts of the tables to be printed to the corresponding Excel sheets
Dim course_name As DAO.Recordset 'Matrix of pointers that will hold parts of the tables to be printed to the corresponding Excel sheets
'********************************************************'
'Initialize our tables into thier recordsets for analysis'
'********************************************************'
Set Roster = CurrentDb.OpenRecordset(TblA)
Set Course = CurrentDb.OpenRecordset(TblB)
str = "SELECT Last FROM Roster"
Set last_name = CurrentDb.OpenRecordset(str)
str = "SELECT Course FROM [Course List]"
Set course_name = CurrentDb.OpenRecordset(str)
'**************************************************************************'
'Create the new excel file with default parameters and print the cover page'
'**************************************************************************'
Set excel = CreateObject("Excel.Application")
Set book = excel.Workbooks.Add
excel.Visible = True
Set sheet = book.Worksheets("Sheet1")
str = "Coversheet"
sheet.Name = str
sheet.Range("B2") = "HLC Database Export tool V1.0"
sheet.Range("B3") = "Written by Levi T Jackson, RN, BSN"
sheet.Range("B4") = "All rights reserved, Copyright 2021"
sheet.Range("B5") = "For use only by Emory Healhtcare, and others with permissions"
'**********************************'
'Main Loop, where the magic happens'
'**********************************'
ctrA = 0
Roster.MoveFirst
last_name.MoveFirst
Do Until last_name.EOF 'Move through the list of last names in the table Roster, one at a time
If Roster!Active = True Then 'No need to report on inactive employees, use access query for that
Set Child = Roster!Completion.Value 'Open a Recordset for the multivalued field Completion in Roster
ctrB = 1
If Child.EOF = True Then 'save the number of records for printing, or set to 0
var = 0
Else
Child.MoveLast
var = Child.RecordCount
Child.MoveFirst
End If
Course.MoveLast
If Child.EOF = False Then 'Avoid errors by not processing a page if no completion records exist
Set sheet = book.sheets.Add(After:=book.Worksheets(book.Worksheets.count)) 'For active employees, make a new sheet and switch to it, and set its name to the current last name from Roster
sheet.Activate
sheet.Range("A1").SELECT
str = Roster!Last & ", " & Roster!First
sheet.Name = str
sheet.Range("B2") = "Courses Completed"
Do Until Child.EOF 'If there are records in Completion for the current name, print them, move on when done
Course.MoveFirst
course_name.MoveFirst
Do Until Course.EOF
If Course![Course ID] = CInt(Child!Value.Value) Then
sheet.Range("D" & Mid(coordinates(ctrB), 2, Len(coordinates(ctrB)) - 1)) = Course![Course ID] 'prints course ID next to the name
sheet.Range("D2") = "'" & CStr(var) & " / " & CStr(Course.RecordCount) 'Prints number of records in completions
sheet.Range("B3") = "Course Name"
sheet.Range("D3") = "Course ID"
sheet.Range(coordinates(ctrB)) = Course!Course 'Prints course name
ctrB = ctrB + 1
Course.MoveLast
Course.MoveNext
Else
Course.MoveNext
course_name.MoveNext
End If
Loop
Child.MoveNext
Loop
End If
ctrA = ctrA + 1 'I might use this later in code updates, counts how manmy records are processed
Child.Close
excel.ActiveSheet.Cells.SELECT 'Selects all of the cells
excel.ActiveSheet.Cells.EntireColumn.AutoFit 'Does the "autofit" for all columns
sheet.Range("A1").SELECT 'Selects the first cell to unselect all cells
End If
Roster.MoveNext
last_name.MoveNext
Loop
'Clean up recordsets
last_name.Close
course_name.Close
Roster.Close
Set Roster = Nothing
Course.Close
Set Course = Nothing
End Function
'Converts the iteration of the print course sub loop into a sheet coordinate cell and returns it as a string
'This function is here so that later a more complicated printing coordinate system can be easily added as the database grows larger
Private Function coordinates(num As Integer) As String
coordinates = "B" & CStr(num + 4)
End Function

Answer 1

Add an order by clause to your OpenRecordset statements.