第二次导出到EXCEL时出错！！！

Question

由于导出到EXCEL中的数据需要做一写排版工作，就直接把要排版的代码，用EXCEL录制宏的办法把代码粘贴到VB的代码区了。具体代码为：
Select Case Button.Key
     CASE "OUTPUT"
            CdlZPCP.Filter = "Excel(*.xls)|*.xls"
            CdlZPCP.ShowSave
            If CdlZPCP.FileName = "" Then Exit Sub
            FileName = CdlZPCP.FileName
            Set xlApp = CreateObject("Excel.Application")
            Set xlBook = xlApp.Workbooks.Add
            Set xlSheet = xlApp.Worksheets(1)
            With msgZPCPIn
            ReDim DBArray(.Rows - 1, .Cols - 1)
                    frmPercent.iPerc = .Rows
                    frmPercent.Show
                    xlSheet.Cells(2, 1).Value = Label2(0).Caption
                    xlSheet.Cells(2, 2).Value = "'" & txtZPCP(0).Text
                    xlSheet.Cells(2, 2).Select
                    For intCount = 1 To 5
                        xlSheet.Cells(intCount + 2, 1) = Label2(intCount).Caption
                        xlSheet.Cells(intCount + 2, 2) = "'" & txtZPCP(intCount).Text
                    Next intCount
                    xlSheet.Range(xlSheet.Cells(2, 2), xlSheet.Cells(7, 2)).Select
                    UnderLine
                    For intCount = 6 To 10
                        xlSheet.Cells(intCount - 3, 3) = Label2(intCount).Caption
                        xlSheet.Cells(intCount - 3, 4) = "'" & txtZPCP(intCount).Text
                    Next intCount
                    xlSheet.Range(xlSheet.Cells(3, 4), xlSheet.Cells(7, 4)).Select
                    UnderLine
                    For intCount = 11 To 15
                        xlSheet.Cells(intCount - 8, 5) = Label2(intCount).Caption
                        xlSheet.Cells(intCount - 8, 6) = "'" & txtZPCP(intCount).Text
                        xlSheet.Cells(intCount - 8, 6).Select
                    Next intCount
                    xlSheet.Range(xlSheet.Cells(3, 6), xlSheet.Cells(7, 6)).Select
                    UnderLine
                    For iRow = 0 To .Rows - 1
                        For iCol = 0 To .Cols - 1
                            frmPercent.Show
                            frmPercent.lblPercent = CStr(Round(((iRow + 1) / .Rows) * 100)) & "%"
                            frmPercent.lblPercent.Refresh
                            frmPercent.PrgBar.Value = iRow + 1
                            DBArray(iRow, iCol) = "'" & .TextMatrix(iRow, iCol)
                        Next iCol
                    Next iRow
                    xlSheet.Cells(9, 1).Resize(.Rows, .Cols).Value = DBArray
                    xlSheet.Range(xlSheet.Cells(9, 1), xlSheet.Cells(.Rows + 9, .Cols)).Select
                    '给每个指定区域单元格设置边框， 此处为直接从VBA中粘贴进来的代码
                    Selection.Borders(xlDiagonalDown).LineStyle = xlNone  
                    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                    With Selection.Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .Weight = xlMedium
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .Weight = xlMedium
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .Weight = xlMedium
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlEdgeRight)
                        .LineStyle = xlContinuous
                        .Weight = xlMedium
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlInsideVertical)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlInsideHorizontal)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    xlSheet.Cells(.Rows + 10, 1) = Label2(16).Caption
                    xlSheet.Cells(.Rows + 10, 2) = "'" & txtZPCP(16).Text
                    xlSheet.Cells(.Rows + 10, 3) = Label2(17).Caption
                    xlSheet.Cells(.Rows + 10, 4) = "'" & txtZPCP(17).Text
                    Unload frmPercent
                    xlSheet.Columns.AutoFit
                    xlSheet.Cells(1, 1).Value = Label1.Caption
                    xlSheet.Cells(1, 1).Font.Name = "宋体"
                    xlSheet.Cells(1, 1).Font.Size = 22
                    xlSheet.Cells(1, 1).Font.Bold = True
                    xlSheet.Cells(1, 1).Select
                    xlSheet.SaveAs FileName
                    CdlZPCP.FileName = ""
                    xlSheet.Application.Quit
                    Set xlBook = Nothing
                    Set xlSheet = Nothing
            End With
END SELECT
Sub UnderLine()   '给每个单元格设置边框中的下边框 此处为直接从VBA中粘贴进来的代码
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End Sub
当第一执行此代码时，是可以顺利导出到EXCEL中去的，但是在任务管理器里面还能看到EXCEL在运行，EXCEL没有被xlSheet.Application.Quit
                    Set xlBook = Nothing
                    Set xlSheet = Nothing给关掉。当第二次导出时就报错了。
如果不做那些画边框的代码就没有问题，也能正常关闭EXCEL.

Answer 1

EXCEL没有被xlSheet.Application.Quit
                    Set xlBook = Nothing
                    Set xlSheet = Nothing给关掉。当第二次导出时就报错了
---------------------------------------------------------------------------
把释放部分的代码改一下试试：xlBook.Close
xlApp.Quit 
Set xlApp = Nothing
Set xlBook = Nothing

Answer 2

释放代码改成如下：
xlbook.close
xlapp.quit
set xlbook = nothing
set xlapp = nothing

Answer 3

改过了，不行，还是关不掉Excel。写了捕捉错误，代码如下：
当第二次到出时候被捕捉到错误，问我要不要保存“book1”.这就充分说明第一次保存的那个Excel还是留在进程里面，没有关闭掉！
SaveError:
    xlSheet.Application.Quit
    'Debug.Print Err.Description
    'Debug.Print Err.Number
    Set xlBook = Nothing
    Set xlSheet = Nothing
    MsgBox "意外错误！", vbOKOnly + vbCritical, "警告"

Answer 4

如果你的book1的内容已经改变，在xlbook.Close的时候，是会有提示的，你在前面加一句，再试xlApp.DisplayAlerts = False
xlbook.close
xlapp.quit
set xlbook = nothing
set xlapp = nothing

Answer 5

'............保存文件
       xlapp.ActiveWorkbook.Close
       xlapp.Quit
    '................关闭文件
       Set xlsheet = Nothing
       Set xlbook = Nothing
       Set xlapp = Nothing

Answer 6

要仔细找找,有没有不是定义对象变量开头的,如 Selection应是xlapp.Selection

Answer 7

我把所有Selection前面都加了xlapp了。还是关不掉！
去掉Unline过程和设置单元格边框的代码就没有问题，能够关掉的。

Answer 8

要不资源释放完整才能退出：下面这3句，少一句都不行，你仔细检查看看是不是少了哪句
Set xlsheet = Nothing
Set xlbook = Nothing
Set xlapp = Nothing

Answer 9

仔细找找,有没有不是定义对象变量开头的
仔细找找,有没有不是定义对象变量开头的
仔细找找,有没有不是定义对象变量开头的
仔细找找,有没有不是定义对象变量开头的
仔细找找,有没有不是定义对象变量开头的
仔细找找,有没有不是定义对象变量开头的
不仅仅指Selection这一个.

Answer 10

搞定了,faysky2()说的对,我确实少了一句set xlapp=nothing
谢谢。
同样也谢谢楼上的那位兄弟。
I love CSDN!