大量数据从数据库导出到EXCEL报内存溢出错误，请问如何解决？

If Adodc1.Recordset.RecordCount = 0 Then Exit Sub '如果当前表格无数据，则退出过程
    Dim xlApp As Object ' Excel.Application
    Dim xlBook As Object ' Excel.Workbook
    Dim xlsheet As Object 'Excel.Worksheet
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    xlApp.Visible = False
    Set xlsheet = xlBook.Worksheets("sheet1")
   
   
    'Dim xlApp As excel.Application '定义EXCEL类
    'Dim xlBook As excel.Workbook '定义工件簿类
    'Dim xlsheet As excel.Worksheet '定义工作表类
    'Set xlApp = CreateObject("Excel.Application")   '创建EXCEL对象
    'Set xlBook = xlApp.Workbooks.Add                '添加空文档
    'xlApp.Visible = False                           '设置EXCEL对象可见
    'Set xlsheet = xlBook.Worksheets("sheet1")       '设置活动工作表
    xlApp.ScreenUpdating = False  '屏幕更新关
    '给excel定义标题栏
    With xlsheet
         .Range("A1").Value = "ID"
         .Range("B1").Value = "文件名"
         .Range("C1").Value = "管芯编号"
         .Range("D1").Value = "测试项目"
         .Range("E1").Value = "管脚号"
         .Range("F1").Value = "测试值"
         .Range("G1").Value = "单位"
         .Range("H1").Value = "Site号"
   
    End With
    xlsheet.Range("A2").CopyFromRecordset Adodc1.Recordset   '从主窗体的表格中导出数据
    '给excel表格加边框
    Dim lCols As Long
    Dim lRows As Long
    lRows = xlsheet.UsedRange.Cells.Rows.Count '判断行数
    If lRows > 3 Then  '如果行数lrows大于3，则加边框
        xlsheet.Range("A1:N" & lRows).Select
        xlsheet.Range("A1").Activate
        Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
        Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
        Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
        Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
        Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
        Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End If
    xlsheet.Range("A1:H65535").HorizontalAlignment = xlCenter '调整居中对齐
    xlsheet.Columns("A:B").HorizontalAlignment = xlCenter
    xlsheet.Cells.Font.Size = 9
xlsheet.Columns(1).ColumnWidth = 5 '调整列宽
xlsheet.Columns(2).ColumnWidth = 25 '调整列宽
xlsheet.Columns(3).ColumnWidth = 10 '调整列宽
xlsheet.Columns(4).ColumnWidth = 20 '调整列宽
xlsheet.Columns(5).ColumnWidth = 10 '调整列宽
xlsheet.Columns(6).ColumnWidth = 10 '调整列宽
xlsheet.Columns(7).ColumnWidth = 10 '调整列宽
xlsheet.Columns(8).ColumnWidth = 10 '调整列宽
'按当前日期与时间保存导出的文件
If Dir(App.Path & "\导出", vbDirectory) = "" Then MkDir App.Path & "\导出" '如果不存在文件夹则创建之
xlBook.SaveAs App.Path & "\导出\" & Format(Now, "yyyy年mm月dd日-hh时mm分ss秒") & "导出.xls", FileFormat:=xlExcel8 ', Password:="123"
'在退出窗体前，释放excel相应变量

xlBook.Close
Set xlsheet = Nothing
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing