Sub ExcelReport(ByRef frm As Form, lngReportID As Long, strFile As String)
    'On Error Goto ExcelReport_Err
    'Leaving an orphaned Excel.exe process...
    
    Dim strSQLSheet As String
    Dim db As DAO.Database
    Dim rsSheet As DAO.Recordset
    Dim rsSheetLayout As DAO.Recordset
    Dim qry As DAO.QueryDef
    Dim strSQLSPT As String
    Dim strSelectClause As String
    Dim XL As Excel.Application
    Dim XLBook As Excel.Workbook
    Dim XLSheet As Excel.Worksheet
    Dim XLRange As Excel.Range
    Dim XLBorder As Excel.Border
    Dim lngCol As Long
    Dim i As Integer
            
    Set db = CurrentDb()
    'Open Current ACE table for 'Report' / Workbook to be created
    Set rsSheet = db.OpenRecordset("Select SheetID, ReportID, SheetNumber, SheetName, ReportHeader, SourceProcedure, CriteriaField From Sheet Where ReportID = " & lngReportID & vbCrLf & "Order By ReportID, SheetNumber")
    
    While Not rsSheet.EOF
        
        'Lazy code to fix later to deal with dates
        If frm!chkDateFilter Then
            strSQLSPT = " '1/1/2012', '" & Now() & "'"
        Else 'YTD
            strSQLSPT = " '" & frm!txtBegin & "', '" & frm!txtEnd & "'"
        End If
        
        strSQLSPT = rsSheet!SourceProcedure & strSQLSPT
        'Addparameter concatenates a comma and parameter in... InjectionRisk test for nulls and does some other thins to lesson chance of SQL injection
        addParameter strSQLSPT, InjectionRisk(frm.Controls(rsSheet!CriteriaField).Value, True)
        
        'Change SQL property of existing Pass-through query...
        SetSQL "qrySPT MetricProc", strSQLSPT
        
        'Open another ACE table to build a query with report headers
        Set rsSheetLayout = db.OpenRecordset("Select * From SheetLayout Where SheetID = " & rsSheet!SheetID & vbCrLf & "Order By SheetID, Sequence")
                
        strSelectClause = ""
                
        While Not rsSheetLayout.EOF
            
            If Nz(rsSheetLayout!SecondColumnName, "") = "" Then
                'I do not have input on requirement <bangs head against wall>
                If rsSheetLayout!FirstColumnName = rsSheetLayout!GroupHeader Then
                    addParameter strSelectClause, "[" & Replace(rsSheetLayout!FirstColumnName, "#", "|hash|") & "]"
                Else
                    addParameter strSelectClause, "[" & rsSheetLayout!FirstColumnName & "] As [" & Replace(Replace(rsSheetLayout!GroupHeader, ".", "||"), "#", "|hash|") & "]"
                End If
            Else
                addParameter strSelectClause, "[" & rsSheetLayout!FirstColumnName & "] As [" & Replace(Replace(rsSheetLayout!GroupHeader & "|" & rsSheetLayout!FirstHeader, ".", "||"), "#", "|hash|") & "]"
            End If
            
            rsSheetLayout.MoveNext
        Wend
        
        Set qry = db.CreateQueryDef(rsSheet!SheetName, "Select " & strSelectClause & vbCrLf & "From [qrySPT MetricProc];")
        qry.Close
        
        'ACE query based on SPT query built with column aliases with desired sheet names...
        
        'Export Sheet
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, rsSheet!SheetName, strFile, True
        
        DoCmd.DeleteObject acQuery, rsSheet!SheetName
        
        rsSheet.MoveNext
    
    Wend
    
'Finally into Excel here...  A whole bunch of formatting
    Set XL = CreateObject("Excel.Application")
    Set XLBook = XL.Workbooks.Open(FileName:= _
               strFile)
    
    XL.DisplayAlerts = False
    
    XL.Visible = True
    For Each XLSheet In XLBook.Worksheets
        XLSheet.Activate
        Set XLRange = XLSheet.Rows(1)
        XLRange.RowHeight = 32.75
        XLRange.WrapText = True
        
        Set XLRange = XLSheet.Range("A1")
        Set XLRange = Range(XLRange, XLRange.SpecialCells(xlLastCell))
                
        For i = xlEdgeTop To xlInsideHorizontal Step 1 'Constants in Excel 2010 range 8 to 12 consecutively
            
            Set XLBorder = XLRange.Borders(i)
            With XLBorder
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            
        Next
        
        Set XLBorder = Nothing
        
        'Undo replacements in column headings
        XLRange.Replace What:="|hash|", Replacement:="#", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        XLRange.Replace What:="||", Replacement:=".", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        
        XLRange.EntireColumn.AutoFit
               
        
        Set XLRange = XLSheet.Rows(1)
        XLRange.Insert Shift:=xlDown
        XLRange.Insert Shift:=xlDown
        XLRange.Insert Shift:=xlDown
        'GoTo ContinueNext
        
        Set XLRange = XLSheet.Cells(2, 1)
        XLRange.WrapText = True
        XLRange.RowHeight = 32.75
        XLRange.ColumnWidth = 15
        
        
        Set XLRange = XLSheet.Cells(4, 1)
        
        Set XLRange = XLRange.End(xlToRight)
        
        
        lngCol = XLRange.Column
        
        Set XLRange = XLSheet.Range(XLSheet.Cells(2, 2), XLSheet.Cells(2, lngCol))
        
        With XLRange
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        XLRange.Merge
        
        Set XLRange = XLSheet.Range(XLSheet.Cells(3, 2), XLSheet.Cells(3, lngCol))
        With XLRange
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        XLRange.Merge
    
        Set XLRange = XLSheet.Range(XLSheet.Cells(2, 1), XLSheet.Cells(3, lngCol))
        XLRange.Borders(xlDiagonalDown).LineStyle = xlNone
        XLRange.Borders(xlDiagonalUp).LineStyle = xlNone
                
        For i = xlEdgeTop To xlInsideHorizontal Step 1 'Constants in Excel 2010 range 8 to 12 consecutively
            
            Set XLBorder = XLRange.Borders(i)
            With XLBorder
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            
        Next
        
        Set XLBorder = Nothing
        
        rsSheet.FindFirst ("SheetName = """ & XLSheet.Name & """")
        XLSheet.Cells(2, 1).FormulaR1C1 = rsSheet!ReportHeader
ContinueNext:
    Next
    
    XL.DisplayAlerts = True
    
    XL.Visible = True
    
    XLBook.Save
    
   
    
ExcelReport_Cleanup:
    
    Set qry = Nothing
    Set db = Nothing
    
    Set XLRange = Nothing
    
    Set XLSheet = Nothing
    
    If Not (XLBook Is Nothing) Then
        XLBook.Close False
        Set XLBook = Nothing
    End If
    
    If Not (rsSheetLayout Is Nothing) Then
        Set rsSheetLayout = Nothing
    End If
    
    If Not (rsSheet Is Nothing) Then
        Set rsSheet = Nothing
    End If
    
    If Not (XL Is Nothing) Then
        XL.Quit 'Breakpoint here shows Excel is made not visible after execution but can be made visible in immediate window
        Set XL = Nothing
    End If
    
    

Exit Sub
ExcelReport_Err:

    MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & "Error occured in ExcelReport", vbCritical, "Error in ExcelReport"
    Resume ExcelReport_Cleanup

End Sub

Set XLRange = XLSheet.Range("A1")
Set XLRange = XLSheet.Range(XLRange, XLRange.SpecialCells(xlLastCell))