使用Excel的新示例

• 仅仅为了检索一个数字而打开和关闭Excel和一个工作簿看起来有些过分，但是假设我们正在练习处理对象和错误处理。

Function GetSizeColumn(ByVal Path As String, ByVal Size As Double) As Long

    On Error GoTo ClearError
    
    Dim xlApp As Excel.Application: Set xlApp = New Excel.Application
    xlApp.Visible = True ' out-comment when done testing
    
    Dim wb As Excel.Workbook
    Set wb = xlApp.Workbooks.Open(Path, True, True)
    
    Dim SizeColumn As Long
    SizeColumn = wb.Sheets("Sheet1").Rows(1).Find(CStr(Size)).Column
    ' You can avoid the expected error as you have learned in your newer post. 
    ' In this case, if the error occurs, the function will end up with 
    ' its initial value 0 since its result is declared 'As Long'
    ' i.e. the following line will never be executed.
    
    GetSizeColumn = SizeColumn

ProcExit:
    On Error Resume Next
        If Not wb Is Nothing Then wb.Close False
        If Not xlApp Is Nothing Then xlApp.Quit
    On Error GoTo 0
    Exit Function    
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "':" & vbLf & Err.Description
    Resume ProcExit
End Function

试试看。100%工作代码关于创建excel。在这个代码中，excel成功地转换了excel中的记录集。之后成功地关闭了excel。没有错误。
此外，检查任务管理器并关闭过程中打开的所有excel文件。

Public Sub ConvertRecordSetToExcelFull(Rs As Recordset, _
                                   FileNameWithPath As String, _
                                   SheetName As String, _
                                   Rangename As String)

On Error GoTo Error1

Dim ExlFile As Object, Book As Object, Sheet As Object, K As Long, J As Long

Set ExlFile = CreateObject("Excel.Application")
Set Book = ExlFile.Workbooks.Add
Set Sheet = Book.Worksheets(1)
ExlFile.DisplayAlerts = False
K = 1

For J = 0 To Rs.Fields.Count - 1
    Sheet.Cells(K, J + 1) = UCase(Rs.Fields(J).Name)
Next
K = K + 1

If Rs.RecordCount >= 1 Then

    'Call RecCount(rs)
    Do While Rs.EOF <> True

        For J = 0 To Rs.Fields.Count - 1
            Sheet.Cells(K, J + 1) = Rs.Fields(J)
        Next
        K = K + 1
        Rs.MoveNext
    Loop

End If

Book.Worksheets(1).Name = SheetName
Book.SaveAs FileNameWithPath
ExlFile.ActiveWorkbook.Close False
ExlFile.Quit
Set Sheet = Nothing
Set ExlFile = Nothing
Screen.MousePointer = vbNormal
Exit Sub
Error1:
MsgBox Err.Description
Err.Clear
End Sub