'***********************************************************************/'* Function Name: ToExcel */'* Input Arguments: */'* Out Arguments : */'* : */'* Description : */'* Author : by yarno QQ：84115357 */'* Date : 2005-11-25 */'***********************************************************************/Public Function ToExcel()On Error GoTo ErrorHandler Dim exlapp As Excel.ApplicationDim exlbook As Excel.WorkbookSet exlapp = CreateObject("Excel.Application")Set exlbook = exlapp.Workbooks.Addexlapp.Caption = "数据正在导出......"exlapp.Visible = Trueexlapp.DisplayAlerts = FalseDim exlsheet As Excel.WorksheetSet exlsheet = exlbook.Worksheets.Addexlsheet.ActivateSet exlsheet = exlsheetexlsheet.Name = "我导出的数据"'设置列宽exlapp.ActiveSheet.Columns(1).ColumnWidth = 10exlapp.ActiveSheet.Columns(2).ColumnWidth = 20StrSql = "你的SQL语句"Set exl_rs = PubSysCn.Execute(StrSql)exlsheet.Range("A2").CopyFromRecordset exl_rsexl_rs.CloseSet exl_rs = Nothingexlapp.Worksheets("sheet1").Deleteexlapp.Worksheets("sheet2").Deleteexlapp.Worksheets("sheet3").Deleteexlapp.DisplayAlerts = Trueexlapp.Caption = "数据导出完毕！！"exlapp.Visible = TrueSet exlapp = NothingSet exlbook = NothingSet exlsheet = NothingExit FunctionErrorHandler:MsgBox "EXCEL : " & err.Number & " : " & err.DescriptionEnd Function
