Late Binding: extract Access to Excel with formatting

[roelandwatteeuw]

Hi all

Situation:
I'm extracting an Access query to Excel with VBA.
In this excel, I let VBA do a few things like formatting the cells.

I made the code work and the sheet looks good, but I'm not sure if it's all versions proove.

For my code I have put a check in the references at 'Microsoft Excel 16.0 Object Library'
And this all works.
If I uncheck the reference, VBA returns errors.
No problem so far... just keep it on!?

Problem:
But what if an other user doesn't have it checked? Or has an older version of the Object Library?
It would give an error for him, wouldn't it?

I read things about early and late binding, where the early binding could give problems with this.
So I tried to change it to a late binding (using Objects).

When unchecking the Excel Object Library box, the code will still return errors.
Did I do something wrong? (Probably!)


Extra info:
sQuery = Name from the Query
sPath = Filepath where the sheet needs to be added
Both come from other sub

This is my code:

Private Sub cmdTransfer(ByVal sQuery As String, sPath As String)
                                                                                
On Error GoTo SubError

    Dim xlApp           As Object   
    Dim xlBook          As Object
    Dim xlSheet         As Object
    
    Dim rsl             As DAO.Recordset
    Dim iCols           As Integer
    Dim i               As Integer
    Dim bExcelOpened    As Boolean
    
    'Change cursor to hourglass
    DoCmd.Hourglass (True)
    
    '**********************************************************
    '                     GET DATA
    '**********************************************************

    'Put sQuery in recordset
    Set rsl = CurrentDb.OpenRecordset(sQuery, dbOpenSnapshot)

    'If empty > Exit Excel
    If rsl.RecordCount = 0 Then
        MsgBox "no data"
        GoTo SubExit
    End If
    
    '**********************************************************
    '                  SPREADSHEET BUILD UP
    '**********************************************************
    
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")    'Bind to existing instance of Excel
 
    If Err.Number <> 0 Then    'Could not get instance of Excel, so create a new one
        Err.Clear
        On Error GoTo SubError
        Set xlApp = CreateObject("Excel.Application")
        bExcelOpened = False
    Else    'Excel was already running
        bExcelOpened = True
    End If
    
    xlApp.Visible = False
    xlApp.screenupdating = False
    
    'Open Workbook on sPath
    Set xlBook = xlApp.Workbooks.Open(sPath)
    'Set sheet as first sheet
    Set xlSheet = xlBook.sheets.Add(Before:=xlBook.sheets(1))
    
    With xlSheet
        'General formatting sheet
        .Name = "List"
        .Tab.ColorIndex = 6
        .Cells.Font.Name = "Calibri"
        .Cells.Font.Size = 11
        
        'Add titles from table
        For iCols = 0 To rsl.Fields.Count - 1
            .Cells(3, iCols + 1).Value = rsl.Fields(iCols).Name
        Next
        
        'Format titles from tabel
        With xlSheet.Range(xlSheet.Cells(3, 1), _
            xlSheet.Cells(3, rsl.Fields.Count))
            .Font.Bold = True
            .Font.ColorIndex = 2
            .HorizontalAlignment = xlCenter
        End With
        
        'Add BIG title in A1
        With .Range("A1")
            .Value = "This sheet contains the list"
        End With
        
        'Format BIG title
        With xlSheet.Range(xlSheet.Cells(1, 1), _
            xlSheet.Cells(1, rsl.Fields.Count))
            .Merge
            .Cells.Font.Size = 15
            .Font.Bold = True
            .Font.ColorIndex = 1        'See: https://analysistabs.com/excel-vba/colorindex/
            .Interior.ColorIndex = 36
            .HorizontalAlignment = xlCenter
        End With
                
        'Get Data from sQuery
        .Range("A4").CopyFromRecordset rsl
  
        'Format first column
        With xlSheet.Columns("A:A")
            .VerticalAlignment = xlCenter
            .Font.Bold = True
        End With
        
        'Define range from Data sQuery
        Dim indexLastColumn As Integer
            indexLastColumn = .Cells(4, .Columns.Count).End(xlToLeft).Column
        Dim indexLastRow As Integer
            indexLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Dim RangeTabel As Range
            Set RangeTabel = xlSheet.Range(xlSheet.Cells(3, 1), xlSheet.Cells(indexLastRow, indexLastColumn))
                
        'Name Table
        Dim TableName As String
            TableName = "Tbl_List"
        
        'Format data sQuery as Table and name it
        xlSheet.ListObjects.Add(xlSrcRange, RangeTabel, , xlYes).Name = TableName

        'Format Table
        With xlSheet.ListObjects(TableName)
            .TableStyle = "TableStyleMedium2"
            .Range.AutoFilter
        End With

        'ReDefine LastRow
        indexLastRow = indexLastRow + 4
        
        'Add text in new last line + merg, colour and borders
        With xlSheet.Range(xlSheet.Cells(indexLastRow, 1), _
            xlSheet.Cells(indexLastRow, indexLastColumn))
            .Merge
            .Value = "For more information, contact me"
            .Interior.ColorIndex = 36
            .Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
            .Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlContinuous
            .Borders(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
            .Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
        End With
      
        'Autofit rows and columns
        .Columns("B").ColumnWidth = 120        'first wide to prevent early text wrap
        .Rows.AutoFit
        .Columns.AutoFit
        
        'Select first cel
        .Range("A1").Select
        'Select first sheet in workbook
        xlBook.sheets(1).Select
    End With
    
    xlApp.DisplayAlerts = False
        xlBook.Close True, sPath    'Save and close the workbook
    xlApp.DisplayAlerts = True
    
    'Close excel if is wasn't originally running
        If bExcelOpened = False Then
            xlApp.Quit
        End If
 
SubExit:
On Error Resume Next
    DoCmd.Hourglass False
    xlApp.Visible = True
    rsl.Close
    Set rsl = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
    xlApp.screenupdating = True
    Set xlApp = Nothing
    
    Exit Sub
    
SubError:
Error_Handler:
    MsgBox "An error occured:" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: cmdTransfer" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "Error!"
     Resume SubExit
End Sub

Many thanks for helping me clearing this out!

Greetz
R

 

[RoryA]

Citrix is a nightmare with Office in my experience so I can't help you there.

 

[roelandwatteeuw]

Citrix is a nightmare with Office in my experience so I can't help you there.

No problem!
I'm happy with all your help!

Skipping this one sentence works fine.
I probably need to create a Citrix Object ...
But I'll keep it as is.

 

[roelandwatteeuw]

Adding 'xlBook.Save' before quiting the app did the trick ^^