标题: access程序执行完毕仍有excel驻留在内存 [打印本页] 作者: aleeado 时间: 2013-4-17 12:24 标题: access程序执行完毕仍有excel驻留在内存 执行导出到EXCEL后,在任务管理器发现还有一个EXCEL的进程驻留,要退出ACCESS后该进程才消失,不知道为什么?如何在只是关闭窗体后就清理EXCEL进程?如下为该过程代码,请高手赐教:
Private Sub OutputExcel_Click()
On Error GoTo Err_OutputExcel_Click
DoCmd.SetWarnings False
Dim xlApp As excel.Application
Dim xlBook As Workbook
Dim xlSheet As Worksheet
Set xlApp = CreateObject("Excel.Application")
Set xlApp = New excel.Application
Dim Myrecordset As ADODB.Recordset
Dim strSQL As String
Dim recordamt As Integer
Dim c As Integer
Dim i As Integer
xlApp.DisplayAlerts = False
'导出
Set xlBook = Workbooks.Add
Set xlSheet = ActiveWorkbook.Sheets(1)
Set Myrecordset = New ADODB.Recordset
strSQL = "SELECT * from 表1"
Myrecordset.Open strSQL, CurrentProject.Connection, adOpenStatic
recordamt = Myrecordset.RecordCount
Myrecordset.MoveFirst
With xlSheet
.Range("B7").CopyFromRecordset Myrecordset
c = 2
For i = 0 To Myrecordset.Fields.Count - 1
xlApp.ActiveSheet.Cells(6, c).Value = Myrecordset.Fields(i).Name
c = c + 1
Next i
End With
Set Myrecordset = Nothing
Set Conn = Nothing
xlApp.ActiveWorkbook.SaveAs "D:\TEMP\TEST1.xlsx"
xlApp.Quit
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
MsgBox "完成导出"
Exit_OutputExcel_Click:
Exit Sub
Err_OutputExcel_Click:
MsgBox Err.Description
Resume Exit_OutputExcel_Click
End Sub 作者: 轻风 时间: 2013-4-17 12:51
对美女的问题表示关注作者: tmtony 时间: 2013-4-17 13:10
1.里面代码看看中间执行有否出错.
2.另把 xlApp.visible=true 看看是否真正退出了作者: aleeado 时间: 2013-4-17 17:27
Private Sub OutputExcel_Click()
On Error GoTo Err_OutputExcel_Click
Dim xlApp As Excel.Application
Dim xlBook As Workbook
Dim xlSheet As Worksheet
Dim Myrecordset As ADODB.Recordset
Dim strSQL As String
Dim c As Integer
Dim i As Integer
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Sheets(1)
xlApp.DisplayAlerts = False
Set Myrecordset = New ADODB.Recordset
strSQL = "SELECT * from 表1"
Myrecordset.Open strSQL, CurrentProject.Connection, adOpenStatic
xlSheet.Range("B7").CopyFromRecordset Myrecordset
c = 2
For i = 0 To Myrecordset.Fields.Count - 1
xlApp.ActiveSheet.Cells(6, c).Value = Myrecordset.Fields(i).Name
c = c + 1
Next i
Myrecordset.Close
Set Myrecordset = Nothing
Set xlSheet = Nothing
xlBook.SaveAs "c:\TEST1.xlsx"
xlBook.Close
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
MsgBox "完成导出"
Exit_OutputExcel_Click:
Exit Sub
Err_OutputExcel_Click:
MsgBox Err.Description
Resume Exit_OutputExcel_Click
End Sub作者: chaosheng 时间: 2013-4-17 22:31
哦对,这样比较好:
Private Sub OutputExcel_Click()
On Error GoTo Err_OutputExcel_Click
Dim xlApp As Excel.Application
Dim xlBook As Workbook
Dim xlSheet As Worksheet
Dim Myrecordset As ADODB.Recordset
Dim strSQL As String
Dim c As Integer
Dim i As Integer
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Sheets(1)
xlApp.DisplayAlerts = False
Set Myrecordset = New ADODB.Recordset
strSQL = "SELECT * from 表1"
Myrecordset.Open strSQL, CurrentProject.Connection, adOpenStatic
xlSheet.Range("B7").CopyFromRecordset Myrecordset
c = 2
For i = 0 To Myrecordset.Fields.Count - 1
xlApp.ActiveSheet.Cells(6, c).Value = Myrecordset.Fields(i).Name
c = c + 1
Next i
xlBook.SaveAs "c:\TEST1.xlsx"
MsgBox "完成导出"
Exit_OutputExcel_Click:
On Error Resume Next
Set xlSheet = Nothing
xlBook.Close
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
Myrecordset.Close
Set Myrecordset = Nothing
Exit Sub
Err_OutputExcel_Click:
MsgBox Err.Description
Resume Exit_OutputExcel_Click
End Sub作者: aleeado 时间: 2013-4-18 12:20