数据快速导入EXCEL

Public Function ToExcel()
    On Error GoTo ErrorHandler

    Dim exlapp As Excel.Application
    Dim exlbook As Excel.Workbook
    Set exlapp = CreateObject("Excel.Application")
    Set exlbook = exlapp.Workbooks.Add
    exlapp.Caption = "数据正在导出......"
    exlapp.Visible = True
    exlapp.DisplayAlerts = False

    Dim exlsheet As Excel.Worksheet

    Set exlsheet = exlbook.Worksheets.Add

    exlsheet.Activate
    Set exlsheet = exlsheet
    exlsheet.Name = "【我导出的数据】"

    '设置列宽
    exlapp.ActiveSheet.Columns(1).ColumnWidth = 10

    exlapp.ActiveSheet.Columns(2).ColumnWidth = 20


    StrSql = "【你的SQL语句】"

    Set exl_rs = PubSysCn.Execute(StrSql)

    exlsheet.Range("A2").CopyFromRecordset exl_rs

    exl_rs.Close
    Set exl_rs = Nothing

    exlapp.Worksheets("sheet1").Delete
    exlapp.Worksheets("sheet2").Delete
    exlapp.Worksheets("sheet3").Delete
    exlapp.DisplayAlerts = True
    exlapp.Caption = "数据导出完毕！！"
    exlapp.Visible = True

    Set exlapp = Nothing
    Set exlbook = Nothing
    Set exlsheet = Nothing

    Exit Function

ErrorHandler:
    MsgBox "EXCEL : " & err.Number & " : " & err.Description
End Function

[本日志由 JiaJia 于 2008-03-29 05:21 PM 编辑]
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags: VBVB EXCELEXCEL