怎样导出ado.recordset里的数据到excel?

Question

如何用程序生成空excel表？
如何导出数据？
请大家帮忙哦

Answer 1

把ado.recordset当作参数传入这个函数
Public Function ExportToExcel(rst As ADODB.Recordset) As BooleanOn Error GoTo ExportToExcel_ErrorHandler    Dim objExcelApp As Object
    Dim objExcelBook As Object
    Dim objExcelSheet As Object    'Whether Excel exists, if not, try to create
    On Error Resume Next
    Set objExcelApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
         Set objExcelApp = CreateObject("Excel.Application")
    End If
    On Error GoTo ExportToExcel_ErrorHandler    Set objExcelBook = objExcelApp.Workbooks.Add
    Set objExcelSheet = objExcelBook.Worksheets(1)
    
    If Val(objExcelApp.Application.Version) >= 8 Then
        Set objExcelSheet = objExcelApp.ActiveSheet
    Else
        Set objExcelSheet = objExcelApp
    End If
    
    Dim lngRowsCount As Long, lngColumnsCount As Long, lngRow As Long, lngColumn As Long
    Dim strText As String
    
    lngRowsCount = rst.RecordCount
    lngColumnsCount = rst.Fields.Count
    For lngRow = 1 To lngRowsCount
        For lngColumn = 1 To lngColumnsCount
            strText = rst.Fields(lngColumn - 1)
            If IsNull(strText) = False And strText <> "" Then
                objExcelSheet.Cells(lngRow, lngColumn) = strText
            End If
        Next
    Next
    
    objExcelApp.Visible = True
    
    Set objExcelSheet = Nothing
    Set objExcelBook = Nothing
    Set objExcelApp = Nothing
    
    
    ExportToExcel = True
    
ErrorHandler:
    Exit Function
ExportToExcel_ErrorHandler:
    MsgBox Err.Description
    Resume ErrorHandler
    
End Function

Answer 2

使用copyfromrecordset函数
下面是msdn中给出的解释和例子CopyFromRecordset Method
                Copies the contents of an ADO or DAO Recordset object onto a worksheet, beginning at the upper-left corner of the specified range. If the Recordset object contains fields with OLE objects in them, this method fails.Syntaxexpression.CopyFromRecordset(Data, MaxRows, MaxColumns)expression   Required. An expression that returns a Range object.Data   Required Void. The Recordset object to copy into the range. MaxRows   Optional Variant. The maximum number of records to copy onto the worksheet. If this argument is omitted, all the records in the Recordset object are copied.MaxColumns   Optional Variant. The maximum number of fields to copy onto the worksheet. If this argument is omitted, all the fields in the Recordset object are copied.ResCopying begins at the current row of the Recordset object. After copying is completed, the EOF property of the Recordset object is True.
例子如下：For iCols = 0 to rs.Fields.Count - 1
    ws.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
ws.Range(ws.Cells(1, 1),  _
    ws.Cells(1, rs.Fields.Count)).Font.Bold = True
ws.Range("A2").CopyFromRecordset rs至于空的excel表嘛，你可以新建一个workbook,然后保存。
Set newAp = New Excel.Application
Set newBook = newAp.Workbooks.AddExcelFileName = newAp.GetSaveAsFilename("Report", "Microsoft Excel(*.xls),*.xls", , "保存")
If ExcelFileName <> "False" Then
    newBook.SaveAs ExcelFileName
Else
    newBook.Saved = True
End If
newBook.Close
newAp.Quit
Set newBook = Nothing
Set newAp = Nothing