Create excel from access - issue formating table

Attached vba code generates an excel spreadsheet.

I am trying to format the spreadsheet as a table in Excel 2007. Looking to get alternating blue lines.

All works OK untill I run it a second time in the database - It either comes up with "Run time error 5 - invaild call or argument" if I have the first excel spreadsheet still open.

If I close excel before running again I get 'run time error '1004' method 'Range' of object _Global failed"

error on line "xlObj.ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1", strRangeCell), , xlYes).NAME = strTableName"

If I close access and open again works fine (first time).

Running this in Access 2007 in a adp database.

Appreciate any ideas on what could be causing this.

Sub test()

Dim con As Object
Set con = Application.CurrentProject.Connection

Dim rstExcel As ADODB.Recordset
Dim strSQLExcel As String
Dim i As Integer, j As Integer
Dim ssql As String, xlFile As String
Dim xlObj As Object
Dim Sheet As Object

strSQLExcel = "SELECT * from DR_Accs"

Set rstExcel = CreateObject("ADODB.Recordset")
rstExcel.Open strSQLExcel, con, 1   ' 1 = adOpenKeyset

Set xlObj = CreateObject("Excel.Application")
    xlObj.Workbooks.Add
Set Sheet = xlObj.ActiveWorkbook.Sheets(1)
   
'copy the headers
Dim iRow, iCol
iRow = 1
    For iCol = 0 To rstExcel.Fields.Count - 1
        Sheet.Cells(iRow, iCol + 1).Value = rstExcel.Fields(iCol).NAME
    Next

Sheet.Range("A2").CopyFromRecordset rstExcel
xlObj.Visible = True

Sheet.Rows("1:1").Font.Bold = True

Dim dblLastRow As Double

With Sheet.Range("A1").CurrentRegion
    .EntireColumn.AutoFit
    dblLastRow = .Rows.Count
End With

If CInt(xlObj.Version) = 12 Then
    Dim strRangeCell As String
    strRangeCell = Sheet.Cells(dblLastRow, rstExcel.Fields.Count).Address
    Dim strTableName As String
    strTableName = "Table" & Format(Now, "ddmmyyhmm")
    xlObj.ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1", strRangeCell), , xlYes).NAME = strTableName
    xlObj.Range(strTableName & "[#All]").Select
    xlObj.ActiveSheet.ListObjects(strTableName).TableStyle = "TableStyleMedium2"
End If

Set Sheet = Nothing

Set xlObj = Nothing
    
End Sub

Select all Open in new window