将sqlserver2000中的数据导出到Ｅxcel2000

Question

如何将sqlserver2000中的查询到的记录集导出到excel200中去，请结出代码

Answer 1

首先请在"引用"菜单中加上"Microsoft Excel 9.0 Object Library",程序代码如下:  Dim appGas As Excel.Application
  Dim shtGas As Workbook
  Dim rngGas As Range
  Dim ExcelWasNotRunning As Boolean
  Dim filnam As String  
  Dim tmprs As ADODB.Recordset
  Dim tmpmsgtext As String
  Dim fldnumm As Integer
  Dim recnumm As Integer  tmprs.open "select * from ...",conn,1,1
  If (tmprs.EOF) Then
    MsgBox "未检索到数据！"
    tmprs.Close
    Exit Sub
  End If
  Set appGas = GetObject(, "Excel.Application")
  If Err.Number <> 0 Then
    Set appGas = CreateObject("Excel.Application")
    ExcelWasNotRunning = True
  End If
  Application.DisplayAlerts = True
  filnam = Application.GetSaveAsFilename("", FileFilter:="Excel Files (*.xls), *.xls")
  If (filnam = "False") Then Exit Sub
  Err.Clear
  On Error GoTo 0
  Screen.MousePointer = 11
  appGas.Visible = False
  Set shtGas = Workbooks.Add
  For fldnumm = 0 To tmprs.Fields.Count - 1
    ActiveSheet.Cells(1, fldnumm + 1).Value = tmprs.Fields(fldnumm).Name
  Next fldnumm
  recnumm = 1
  Do While Not tmprs.EOF
    recnumm = recnumm + 1
    For fldnumm = 0 To tmprs.Fields.Count - 1
      ActiveSheet.Cells(recnumm, fldnumm + 1).Value = tmprs.Fields(fldnumm).Value
    Next fldnumm
    tmprs.MoveNext
    fmainform.StatusBar1.Panels(1).Text = "已导出" & recnumm & "条数据"
  Loop
  shtGas.SaveAs FileName:=filnam
  shtGas.Close
  Set shtGas = Nothing
  Set rngGas = Nothing
  If ExcelWasNotRunning = True Then
    appGas.Quit
  End If
  Set appGas = Nothing
  Screen.MousePointer = 0
  MsgBox "数据导出完毕！"

Answer 2

------------------------------------------------------------------
个人专栏：http://www.csdn.net/develop/author/netauthor/lihonggen0/
------------------------------------------------------------------

Answer 3

'存字段长度值
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)    With Rs_Dzgl_Receipt
        If .RecordCount < 1 Then
            MsgBox ("没有记录!")
            Exit Sub
        End If
        xlSheet.Cells(1, 4).Value = .Fields("bt")
        xlSheet.Cells(2, 1).Value = .Fields("invoice")
        xlSheet.Cells(2, 9).Value = .Fields("packdate")
        xlSheet.Cells(3, 1).Value = .Fields("")
                        
        '合并单元格
        Dim nIcol As Integer
        
        xlSheet.Range(xlSheet.Cells(3, 1), xlSheet.Cells(5, 9)).Select
            With xlApp.Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
               .MergeCells = True
            End With
            
        xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 9)).Select
            With xlApp.Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
               .MergeCells = True
            End With
        '网格线
        With xlSheet
            .Range(.Cells(1, 1), .Cells(1, 9)).Font.Name = "黑体"
            '设标题为黑体字
            .Range(.Cells(1, 1), .Cells(1, 9)).Font.Bold = True
            '标题字体加粗
            .Range(.Cells(1, 1), .Cells(1, 9)).Borders.LineStyle = xlContinuous
            '设表格边框样式
        End With
        
        '显示表格
        Dim ExclFileName As String
        ExclFileName = App.Path & "\箱单" & Text1(1).Text & ".xls"
        If Dir(ExclFileName) <> "" Then
            Kill ExclFileName
        End If
        xlSheet.SaveAs (ExclFileName)
        xlApp.Application.Visible = True
        '交还控制给Excel
        xlSheet.PrintPreview
       ' xlApp.Application.Quit
       ' xlApp.Quit
    End With

Answer 4

用VB控制EXCEL生成报表 
做为一种简捷、系统的 Windows应用程序开发工具，Visual Basic 5 具有强大的数据处理功能，提供了多种数据访问方法，可以方便地存取Microsoft SQL Server、Oracle、XBase等多种数据库，被广泛应用于建立各种信息管理系统。但是，VB缺乏足够的、符合中文习惯的数据表格输出功能，虽然使用Crystal Report控件及 Crystal Reports程序可以输出报表，但操作起来很麻烦，中文处理能力也不理想。Excel作为Micorsoft公司的表格处理软件在表格方面有着强大的功能，我们可用VB5编写直接控制Excel操作的程序,方法是用VB的OLE自动化技术获取Excel 97 的控制句柄,从而直接控制Excel 97的一系列操作。下面给出一个实例：首先建立一个窗体（FORM1）在窗体中加入一个DATA控件和一按钮，引用Microsoft Excel类型库:从"工程"菜单中选择"引用"栏;选择Microsoft Excel 8.0 Object Library;选择"确定"。在FORM的LOAD事件中加入：
　　Data1.DatabaseName = 数据库名称
　　Data1.RecordSource = 表名
　　Data1.Refresh在按钮的CLICK事件中加入
　　Dim Irow, Icol As Integer
　　Dim Irowcount, Icolcount As Integer
　　Dim Fieldlen() "存字段长度值
　　Dim xlApp As Excel.Application
　　Dim xlBook As Excel.Workbook
　　Dim xlSheet As Excel.Worksheet　　Set xlApp = CreateObject("Excel.Application")
　　Set xlBook = xlApp.Workbooks.Add
　　Set xlSheet = xlBook.Worksheets(1)　　With Data1.Recordset
　　.MoveLast　　If .RecordCount < 1 Then
　　　　MsgBox ("Error 没有记录!")
　　　　Exit Sub
　　End If　　Irowcount = .RecordCount "记录总数
　　Icolcount = .Fields.Count "字段总数　　ReDim Fieldlen(Icolcount)
　　.MoveFirst　　For Irow = 1 To Irowcount + 1
　　　For Icol = 1 To Icolcount
　　Select Case Irow
　　Case 1 "在Excel中的第一行加标题
　　xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1).Name
　　Case 2 "将数组FIELDLEN()存为第一条记录的字段长　　If IsNull(.Fields(Icol - 1)) = True Then
　　　　Fieldlen(Icol) = LenB(.Fields(Icol - 1).Name)
　　　　　"如果字段值为NULL,则将数组Filelen(Icol)的值设为标题名的宽度
　　Else
　　　　Fieldlen(Icol) = LenB(.Fields(Icol - 1))
　　End If　　xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
　　　"Excel列宽等于字段长
　　xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1)
　　　"向Excel的CellS中写入字段值
　　Case Else
　　Fieldlen1 = LenB(.Fields(Icol - 1))　　If Fieldlen(Icol) < Fieldlen1 Then
　　xlSheet.Columns(Icol).ColumnWidth = Fieldlen1
　　　"表格列宽等于较长字段长
　　Fieldlen(Icol) = Fieldlen1
　　　"数组Fieldlen(Icol)中存放最大字段长度值
　　Else
　　　xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
　　End If　　xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1)
　　End Select
　　Next
　　If Irow <> 1 Then
　　If Not .EOF Then .MoveNext
　　End If
　　Next
　　With xlSheet
　　.Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Name = "黑体"
　　　"设标题为黑体字
　　.Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Bold = True
　　　"标题字体加粗
　　.Range(.Cells(1, 1), .Cells(Irow, Icol - 1)).Borders.LineStyle = xlContinuous
　　　"设表格边框样式
　　End With
　　xlApp.Visible = True "显示表格
　　xlBook.Save "保存
　　Set xlApp = Nothing "交还控制给Excel
　　End With本程序在中文Windows98、中文VB6下通过。  

Answer 5

Visual Basic 导出到 Excel 提速之法 
   
  　　办法如下： 
   
  　　Excel 是一个非常优秀的报表制作软件，用VBA可以控制其生成优秀的报表，本文通过添加查询语句的方法，即用Excel中的获取外部数据的功能将数据很快地从一个查询语句中捕获到EXCEL中,比起往每个CELL里写数据的方法提高许多倍。 
   
  　　将下文加入到一个模块中,屏幕中调用如下ExporToExcel("select * from table")则实现将其导出到EXCEL中 
   
   
  Public Function ExporToExcel(strOpen As String) 
  '********************************************************* 
  '* 名称：ExporToExcel 
  '* 功能：导出数据到EXCEL 
  '* 用法：ExporToExcel(sql查询字符串) 
  '********************************************************* 
  Dim Rs_Data As New ADODB.Recordset 
  Dim Irowcount As Integer 
  Dim Icolcount As Integer 
   
  Dim xlApp As New Excel.Application 
  Dim xlBook As Excel.Workbook 
  Dim xlSheet As Excel.Worksheet 
  Dim xlQuery As Excel.QueryTable 
   
  With Rs_Data 
  If .State = adStateOpen Then 
  .Close 
  End If 
  .ActiveConnection = Cn 
  .CursorLocation = adUseClient 
  .CursorType = adOpenStatic 
  .LockType = adLockReadOnly 
  .Source = strOpen 
  .Open 
  End With 
  With Rs_Data 
  If .RecordCount < 1 Then 
  MsgBox ("没有记录!") 
  Exit Function 
  End If 
  '记录总数 
  Irowcount = .RecordCount 
  '字段总数 
  Icolcount = .Fields.Count 
  End With 
   
  Set xlApp = CreateObject("Excel.Application") 
  Set xlBook = Nothing 
  Set xlSheet = Nothing 
  Set xlBook = xlApp.Workbooks().Add 
  Set xlSheet = xlBook.Worksheets("sheet1") 
  xlApp.Visible = True 
   
  '添加查询语句，导入EXCEL数据 
  Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1")) 
   
  With xlQuery 
  .FieldNames = True 
  .RowNumbers = False 
  .FillAdjacentFormulas = False 
  .PreserveFormatting = True 
  .RefreshOnFileOpen = False 
  .BackgroundQuery = True 
  .RefreshStyle = xlInsertDeleteCells 
  .SavePassword = True 
  .SaveData = True 
  .AdjustColumnWidth = True 
  .RefreshPeriod = 0 
  .PreserveColumnInfo = True 
  End With 
   
  xlQuery.FieldNames = True '显示字段名 
  xlQuery.Refresh 
   
  With xlSheet 
  .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Name = "黑体" 
  '设标题为黑体字 
  .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = True 
  '标题字体加粗 
  .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous 
  '设表格边框样式 
  End With 
   
  With xlSheet.PageSetup 
  .LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称：" ' & Gsmc 
  .CenterHeader = "&""楷体_GB2312,常规""公司人员情况表&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10日 期：" 
  .RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10单位：" 
  .LeftFooter = "&""楷体_GB2312,常规""&10制表人：" 
  .CenterFooter = "&""楷体_GB2312,常规""&10制表日期：" 
  .RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页" 
  End With 
   
  xlApp.Application.Visible = True 
  Set xlApp = Nothing '"交还控制给Excel 
  Set xlBook = Nothing 
  Set xlSheet = Nothing 
   
  End Function 
   
   
  注:须在程序中引用'Microsoft Excel 9.0 Object Library'和ADO对象,机器必装Excel 2000 
   
  本程序在Windows 98/2000,VB 6 下运行通过

Answer 6

楼上的代码，呵呵，我的http://www.csdn.net/develop/read_article.asp?id=14952

Answer 7

sorry,我是在vbhome網站上找到的，原來作者就在此，幸會。有些我還不懂，還得多多請教你喲！