大量数据从数据库导出到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 数据量大概30万条，报“内存溢出”错误，错误调试指向语句为“ xlsheet.Range("A2").CopyFromRecordset Adodc1.Recordset '从主窗体的表格中导出数据 ” ，
请问如何解决？
[此贴子已经被作者于2018-4-30 23:28编辑过]
