使用vb把sqlserver数据库表中的数据导到excel中（在线等待，一解决就给分）

1、在SQL SERVER里查询Excel数据:-- ======================================================SELECT * FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0','Data Source="c:\book1.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...[Sheet1$] 下面是个查询的示例，它通过用于 Jet 的 OLE DB 提供程序查询 Excel 电子表格。SELECT *
FROM OpenDataSource ( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\Finance\account.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions

下面是Access导入到Excel，SQL Server类似，只需要改变ConnectionString
Private Sub Form_Load()
Dim I, J As Long
Dim conn As ADODB.Connection
Dim rst As ADODB.RecordsetSet conn = New ADODB.Connection
Set rst = New ADODB.Recordset
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\db1.mdb;Persist Security Info=False"
conn.Openrst.CursorLocation = adUseClientrst.Open "select * from tableabc", conn, adOpenDynamic, adLockOptimistic
Dim MyApp As Excel.Application
Dim MyBook As Excel.Workbook
Dim MySheet As Excel.Worksheet
Set MyApp = CreateObject("Excel.Application")
MyApp.Visible = False
Set MyBook = MyApp.Workbooks.Add()
Set MySheet = MyBook.Worksheets(1)J = 1
Do Until rst.EOF
   For I = 1 To rst.Fields.Count
       MySheet.Cells(J, I) = rst.Fields(I - 1)
   Next
   rst.MoveNext
   J = J + 1
LoopMyBook.SaveAs "C:\11.xls"MyApp.QuitSet MyApp = Nothingrst.CloseSet rst = Nothing
Set conn = Nothing
End Sub

Dim oExcel As Excel.Application '定义一个excel的应用对象
Dim oBook As Excel.Workbook     '定义一个工作表
'要使用上面的两个对象必须在工程中引用excel的动态库.
Dim i As Long

    Set oExcel = CreateObject("Excel.Application")
    '用createobject创建一个实例并传给oexcel.
    '还可以直接用set oExcel = new Excel.Application ,
    '原来上面的声明是直接用object的,后来为了VB可以直接看到属性方法才这样写的.

          Set oBook = oExcel.Workbooks.Open(sFullFileName, , , , sRPassword, sWPassword)
        oExcel.Visible = True
        '打开excel了.

     oBook.Close

    oExcel.Quit

Dim myadorstNew As ADODB.Recordset
    Dim filename As String
    Dim i As Long
    Dim j As Long

    Dim MyApp As Excel.Application
    Dim MyBook As Excel.Workbook
    Dim MySheet As Excel.Worksheet

    On Error GoTo ErrInfo


    Set myadorstNew = New ADODB.Recordset
    myadorstNew.ActiveConnection = myAdoCnNew
    myadorstNew.CursorLocation = adUseClient
    myadorstNew.LockType = adLockOptimistic
    myadorstNew.CursorType = adOpenStatic    Set MyApp = CreateObject("Excel.Application")
    MyApp.Visible = False
    Set MyBook = MyApp.Workbooks.Add()
    Set MySheet = MyBook.Worksheets(1)

    myadorstNew.Open "select * from " & strTabName & ""

    j = 1
    Do Until myadorstNew.EOF
       For i = 1 To myadorstNew.Fields.Count
           MySheet.Cells(j, i) = myadorstNew.Fields(i - 1)
       Next
       myadorstNew.MoveNext
       j = j + 1
    Loop

    With CD
        .DefaultExt = "xls"
        .filename = filename
        .CancelError = True
        .DialogTitle = "请输入文件名"
        .ShowSave
    End With

    filename = CD.filename

    MyBook.SaveAs filename    MyApp.Quit
    myadorstNew.Close
    Set myadorstNew = Nothing

    Set MySheet = Nothing
    Set MyBook = Nothing
    Set MyApp = Nothing
    Exit Sub
ErrInfo:
    Select Case Err.Number
        Case 1004
            'MsgBox "请输入Excel文件名！", vbInformation, "错误"
        Case 32755 '点“取消”
        Case Else
            MsgBox "请输入Excel文件名！", vbInformation, "错误"
    End Select
End Sub

Dim xlApp As Excel.Application
    Dim xlbook As Workbook
    Dim xlsheet As Worksheet    Set xlApp = New Excel.Application
    Set xlApp = CreateObject("Excel.Application")

    '激活EXCEL应用程序
    xlApp.Visible = False '隐藏EXCEL应用程序窗口

    strSource = App.path & "\default\统计表.xls"
    '*.xls就是一个模版文件
    strDestination = App.path & "\reporttmp\统计表.xls"

    '将模版文件拷贝到一个临时文件
    FileCopy strSource, strDestination

    Set xlbook = xlApp.Workbooks.Open(App.path & "\reporttmp\统计表.xls")
    '打开工作簿，strDestination为一个EXCEL报表文件
    Set xlsheet = xlbook.Worksheets(1)
    pb.Value = 5
    Me.Refresh
    '负值
    With xlsheet
    '报表头
         .cells(2, 2) = "110KV厦寺变电站功率因数" & Month(mr_tmprs1.Fields("巡检时间").Value) & "月统计表"

        Set mr_tmprs2 = New Recordset
        mr_tmprs2.CursorLocation = adUseClient
        mr_tmprs2.Open "select * from xj_glysTjbb where mc='" & Trim(frmUsetRPtprint.TreeView4.SelectedItem.Text) & "'", p_conn, adOpenStatic, adLockReadOnly
        If mr_tmprs2.RecordCount <> 0 Then
           .cells(10, 4) = mr_tmprs2!qm01
           .cells(10, 6) = mr_tmprs2!qm02
           .cells(10, 8) = mr_tmprs2!qm03
           .cells(10, 10) = mr_tmprs2!qm04
           .cells(10, 12) = mr_tmprs2!qm05
           .cells(10, 14) = mr_tmprs2!qm06
           .cells(15, 4) = mr_tmprs2!qm07
           .cells(15, 6) = mr_tmprs2!qm08
           .cells(15, 8) = mr_tmprs2!qm09
           .cells(15, 10) = mr_tmprs2!qm10
           .cells(15, 12) = mr_tmprs2!qm11
           .cells(15, 14) = mr_tmprs2!qm12
        End If

看看我的专栏吧
有二篇文章：
SQL SERVER 与ACCESS、EXCEL的数据转换（原创）
Visual Basic 导出到 Excel 提速之法（原创）

http://www.csdn.net/develop/author/netauthor/lihonggen0/

下面给出一个实例：首先建立一个窗体（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下通过。

调试易

使用vb把sqlserver数据库表中的数据导到excel中（在线等待，一解决就给分）

解决方案 »