Question

即使我在VBA中关闭它，excel.exe * 32进程仍在Windows任务管理器中打开。我从Access运行以下VBA代码。我看过并尝试了各种解决方案无济于事。关闭excel.exe的唯一方法是退出Access。有人可以指出我错过了什么。

Public Sub GenerateQualityReportsSub()


On Error GoTo ERR_GenerateQualityReportsSub
Dim xl As Excel.Application
Dim wbk As Excel.Workbook
Dim dbs As DAO.Database
Dim rstRpt As DAO.Recordset
Dim objMyRange As Object
Dim rstList As DAO.Recordset
Dim FullOutFileName As String
Dim strSQLList As String
Dim strSQLRpt As String
Dim i As Integer
Dim DiscrepancyRecords As Long
Dim NeedToCloseExcel As Boolean
Dim ReportName As String
Dim col As Integer

'Initialize Variables
Set dbs = CurrentDb
RunDate = Now()
FullOutFileName = "DataQualityDiscrepancyReport.xlsx"
i = 0
DiscrepancyRecords = 0
NeedToCloseExcel = False

'Determine the Reports to Generate
strSQLList = "" & _
  "SELECT ReportNum, ReportName, SheetName, QueryName, [Responsible Department] " & _
  "FROM [Data Quality Reports] " & _
  "ORDER BY ReportNum"
Set rstList = dbs.OpenRecordset(strSQLList, dbOpenSnapshot, dbReadOnly)
If rstList.RecordCount = 0 Then
    i = 0
    GoTo Exit_GenerateQualityReportsSub
Else
    'Open Excel
    Set xl = New Excel.Application                      'Open the Excel File
    xl.Visible = True                                 'Make Excel Invisible to User
    'Create the Excel Spreadsheet and Sheets
    Set wbk = xl.Workbooks.Add                          'Add a Wookbook to the Excel File
    wbk.Sheets("Sheet1").Select                             'Select Sheet 1
    wbk.SaveAs FileName:=FullOutFileName                'Save the Excel File
    NeedToCloseExcel = True
End If

'Create One Sheet Per Report
i = 1
While Not rstList.EOF
    DiscrepancyRecords = 0

'Add, if necessary, and Rename the Sheet
    If i <> 1 Then
        Set wks = xl.Worksheets.Add                           'Add a Wooksheet to the Excel File
    End If
    wbk.Sheets("Sheet" & i).Select                            'Select the new Sheet
    wbk.Sheets("Sheet" & i).Name = rstList("SheetName")       'Rename the Sheet
    Set wks = wbk.activesheet


'Obtain and Write Data to the Excel Sheet
    strSQLRpt = "Select * from [" & rstList("QueryName") & "]"
    Set objMyRange = wks.Cells(xl.activesheet.UsedRange.Rows.Count + 1, 1)
    Set rstRpt = dbs.OpenRecordset(strSQLRpt, dbOpenSnapshot, dbReadOnly)
    If rstRpt.RecordCount = 0 Then
        GoTo Exit_GenerateQualityReportsSub
    Else
        rstRpt.MoveLast
        DiscrepancyRecords = rstRpt.RecordCount
        rstRpt.MoveFirst
    End If

'Write the Column Headers to the Sheet
    For col = 0 To rstRpt.Fields.Count - 1
        wks.Cells(1, col + 1) = rstRpt.Fields(col).Name
    Next col

'Write Data to the Excel Sheeet
    Range("A2").Select
    With objMyRange
        rstRpt.MoveFirst
        .CopyFromRecordset rstRpt
    End With

'Format the Sheet Cells
    Cells.Select
    Selection.Columns.AutoFit
    Range("A1").Select

'Save the Excel File
    wbk.Save                                                'Save the Excel File


NextReport:
'Close the Data Results
    rstRpt.Close
    Set rstRpt = Nothing
    rstList.MoveNext
    i = i + 1
Wend
i = i - 1

'Close the Excel File and Application
xl.Visible = True
wbk.Save
wbk.Close savechanges:=True
xl.Quit
Set wks = Nothing
DoEvents
Set wbk = Nothing
DoEvents
Set xl = Nothing
DoEvents
NeedToCloseExcel = False

'Close the Report Record
rstList.Close
Set rstList = Nothing

Exit_GenerateQualityReportsSub:
If NeedToCloseExcel Then
    xl.Visible = True
    wbk.Save
    wbk.Close savechanges:=True
    xl.Quit
    Set wks = Nothing
    DoEvents
    Set wbk = Nothing
    DoEvents
    Set xl = Nothing
    DoEvents
    NeedToCloseExcel = False
End If
Exit Sub


ERR_GenerateQualityReportsSub:
.....

End Sub

Answer 1

我建议：

不要创建新的Excel应用程序，请先尝试重新使用现有的应用程序。在退出Excel应用程序之前，请确保将用于操作Excel对象的变量设置为Nothing。在您的代码中，您退出应用程序，但仍然保留对某些变量的引用。

'-----------------------------------------------------------------------------
' Return an intance of Excel
' First tries to open an existing instance. If it fails, it will create an instance.
' If that fails too, then we return 'Nothing'
'-----------------------------------------------------------------------------
Public Function GetExcelObject() As Object
    On Error Resume Next
    Dim xlo As Object
    ' Try to get running instance of Excel
    Set xlo = GetObject("Excel.Application")
    If xlo Is Nothing Then
        Set xlo = CreateObject("Excel.Application")
    End If
    Set GetExcelObject = xlo
End Function

然后使用：

Set xl = GetExcelObject()

完成Excel文件后：

' Clear all variables that were used to contain Excel objects
set objMyRange = nothing
set Range = nothing
set Selection = nothing
' Save and close
wbk.Save
wbk.Close savechanges:=True
Set wks = Nothing
Set wbk = Nothing
xl.Quit
Set xl = Nothing

我认为您需要稍微修改一下代码。也许你没有在这里包括所有这些，但有一些不确定的事情：

您使用未声明的变量（选择，单元格，范围）。也许您没有包含声明它们的代码，但要确保在所有VBA文件的顶部都有Option Explicit强制您声明所有变量。
您有一些GoTo Exit_GenerateQualityReportsSub通常表示您的代码需要重构。除了VBA中的错误管理之外，您极少需要使用GoTo。在这种情况下，您可以完美地使用Exit Do退出循环。
这些跳跃使得对代码的推理更加困难。
您还在函数末尾重复了相同的清理代码，以处理GoTo分支。通过复制代码，您可能会降低可维护性，并且在更改代码时忘记更新两个块可能会引入错误。

Excel.exe * 32未在任务管理器中关闭。从Access运行VBA。运行Office 2013

1 个答案: