Creating Excel Chart

[Bob]

Access XP
Windows 2k Pro

The code below is used to export data to a new Excel file and add a
basic chart to the Excel file. I am finding that for the same
criteria (date ranges), that sometimes the code works fine and at
other times I receive error an error message: 1004: 'Sheets' of
object'_Global failed.

Code Calling Function:
Call fnCreateExcelSheet("SELECT dt_Snapshot, icn_cnt
AS [ICN Count], tat_cal_avg AS [Cal TAT Avg]," _
& "tat_wd_avg AS [WD TAT Avg] " _
& "FROM d_daily_counts " _
& "WHERE dt_Snapshot Between #" & dStart & "# And #"
& dEnd & "#;", "Default")

Function that creates Excel file/chart:
Public Function fnCreateExcelSheet(sql As String, Optional
strSheetName As String = "Default")
'-------------------------------------------------------------
' **** http://support.microsoft.com/?id=202169 ***********
' Purpose : Inserts query data into a new Excel worksheet & charts
data.
' Author :
' Phone:
' E-Mail:
' Notes.
' Tables:
' Excel File: Only saved if user explicitly saves the newly created
file.
'-------------------------------------------------------------
' Revision History
'-------------------------------------------------------------
' Tuesday, October 21, 2003 RGO:
'=============================================================
' End Code Header block
Dim dbe As DAO.DBEngine
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim xlApp As New Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWs As Excel.Worksheet
Dim xlChartObj As Excel.Chart
Dim i As Integer
Dim FC As Integer ' Count of number of fields
in query
Dim nr As Integer ' Number of records to
paste
Dim xlSourceRange As Excel.Range
On Error GoTo HandleErr

Set dbe = CreateObject("DAO.DBEngine.36")
Set db = CurrentDb()
nr = 0

Set rst = db.OpenRecordset(sql, dbReadOnly)
If rst.RecordCount < 1 Then
MsgBox "There are no records to export for the date range you
entered. Try new dates.", vbCritical
rst.Close
Set db = Nothing
Set dbe = Nothing
Set xlApp = Nothing
DoCmd.Hourglass False
Exit Function
Else
rst.MoveLast
rst.MoveFirst
nr = rst.RecordCount
End If

FC = rst.Fields.Count
Set xlApp = New Excel.Application
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Add
Set xlWs = xlWB.Worksheets.Add
strSheetName = Left(strSheetName, 31)
xlWs.Name = strSheetName

With xlApp
With xlWs
For i = 1 To FC
' Copy field names to Excel using count of fields
' Bold the column headings and insert field names.
Starting position A1.
' The variable 'i' advances the cursor one cell to the
right for each additional field.
With .Cells(1, i)
.Value = rst.Fields(i - 1).Name
.Font.Bold = True
.Interior.ColorIndex = 6
End With
Next
.Range("A2").CopyFromRecordset rst ' Copy Data
.Range("A1:I10").AutoFilter
For i = 1 To FC
.Columns(i).AutoFit
Next
' Helps the memo field data better fit in cells.
.Cells.Select
.Cells.EntireRow.AutoFit
End With
xlWs.Activate
xlWs.Rows("2:2").Select
.ActiveWindow.FreezePanes = True
xlWs.Rows("1:1").Select
.Selection.NumberFormat = "@" ' Sets format of top rows to
text
.Selection.WrapText = True ' Sets word wrap to true for
top rows
xlWs.Rows("1:1").RowHeight = 51 ' Sets height of top row to
51, which accommodates text.
End With

Set xlSourceRange = _
xlWB.Worksheets(1).Range("a2").CurrentRegion

Set xlChartObj = xlApp.Charts.Add

With xlChartObj
.ChartType = xlLineMarkers
.SetSourceData Source:=xlSourceRange, PlotBy:=xlColumns
.SetSourceData Source:=Sheets("Default").Range("A2" & nr &
""), PlotBy:=xlColumns
.SeriesCollection(1).Name = "=""ICN Count"""
.SeriesCollection(2).Name = "=""Calendar TAT Avg"""
.SeriesCollection(3).Name = "=""Work Day TAT Avg"""

.HasTitle = True
.ChartTitle.Characters.Text = "Daily ICN Count Vs. Avg
Calendar & Avg Work Day TATs"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text =
"Date"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Count"
End With
DoEvents
ExitHere:
Set xlApp = Nothing
Set rst = Nothing
Set db = Nothing
Set dbe = Nothing
DoCmd.Hourglass False
xlApp.Quit

Exit Function

HandleErr:
MsgBox Err & ": " & Err.Description
Resume ExitHere
End Function

Thanks for looking.
Bob