新来的！帮个忙吧！！

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
  '  Rs_Data.Open strOpen, Cn, adOpenStatic, adLockReadOnly
    With Rs_Data
      '  .MoveFirst
        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

    xlApp.Application.Visible = True
    Set xlApp = Nothing  '"交还控制给Excel
    Set xlBook = Nothing
    Set xlSheet = NothingEnd Function

或者用自己写的dll来导出，更灵活些'新建一个ActiveX DLL工程工程名为DbToExcel
'工程-->引用,引用Microsoft ActiveX Data Objects 2.6 Library
'Microsoft Excel 9.0 Objects Library Option ExplicitPrivate Mcnnquery As ADODB.Connection   '定义ADO连接对象
Private Mrsquery As ADODB.Recordset     '定义ADO记录对象
Dim ObjExcel As Excel.Application   '定义Excel对象
Dim ObjWorkBook As Excel.Workbook   '定义工作薄
Dim ObjSheet As Excel.Worksheet     '定义工作表
Dim ObjRange As Excel.Range         '定义用户使用工作表的范围Private Property Set Connquery(ByVal Conn As ADODB.Connection)
    Set Mcnnquery = Conn
End PropertyPrivate Property Get Connquery() As ADODB.Connection
    Set Connquery = Mcnnquery
End PropertyPrivate Property Set Rsquery(ByVal Rs As ADODB.Recordset)
    Set Mrsquery = Rs
End PropertyPrivate Property Get Rsquery() As ADODB.Recordset
    Set Rsquery = Mrsquery
End Property'属性方法共有三个参数
'strcnn 连接对象
'strrs  数据集对象
'strpath EXCEL文件
Public Sub DbtoExcel(Strcnn As ADODB.Connection, Strrs As ADODB.Recordset, Strpath As String)
    Dim i As Integer, j As Integer
On Error GoTo Err
    Set Connquery = Strcnn '设置cnnquery属性
    Set Rsquery = Strrs   '设置rsquery属性
    Set ObjExcel = New Excel.Application
    Set ObjWorkBook = ObjExcel.Workbooks.Open(Strpath)  '打开EXCEL文件
    Set ObjSheet = ObjWorkBook.ActiveSheet
    Set ObjRange = ObjSheet.UsedRange '用户使用过的工作表范围
    For i = 1 To Rsquery.Fields.Count
        ObjRange.Cells(1, i) = Rsquery.Fields(i - 1).Name
    Next i
    For j = 1 To Rsquery.RecordCount
        For i = 0 To Rsquery.Fields.Count - 1
            ObjRange.Cells(j + 1, i + 1) = Rsquery.Fields(i).Value
        Next i
        Rsquery.MoveNext
    Next j
    ObjExcel.Quit
    Set ObjWorkBook = Nothing
    Set ObjRange = Nothing
    Set ObjSheet = Nothing
    Set ObjExcel = Nothing
Err:
    MsgBox Err.Number & " " & Err.Description
    Set ObjWorkBook = Nothing
    Set ObjRange = Nothing
    Set ObjSheet = Nothing
    Set ObjExcel = Nothing
End Sub'文件-->生成DbToExcel.dll '新建一个标准EXE工程
'工程-->引用Microsoft ActiveX Data Objects 2.6 Library
浏览，加载刚才生成的DLL文件 Option Explicit

Dim Conn As ADODB.Connection
Dim Rs As ADODB.RecordsetDim DE As New DbtoExcel.Class1  '定义一个类，DbToExcel.DLL内Class1类的一个实例Private Sub Command1_Click()
    DE.DbtoExcel Conn, Rs, "c\1.xls"
End SubPrivate Sub Form_Load()
    Set Conn = New ADODB.Connection
    Set Rs = New ADODB.Recordset
    Conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\db.mdb;Persist Security Info=False"
    Conn.Open
    Rs.Open "select * from users", Conn, adOpenKeyset, adLockBatchOptimistic
End Sub

'*************************************************************************
'**
'** VB将数据导出到EXCEL,没有安装EXCEL的一样也可以导出.
'**
'** 调用方式: s_Export2Excel(Ado.Recordset) 或 s_Export2Excel(Rds.RecordSet)
'** 支持 Rds 与 Ado 的记录导出
'**
'*************************************************************************'导出ADO记录集到EXCEL
Public Function f_Export2Excel(ByVal sRecordSet As ADODB.Recordset, ByVal sExcelFileName$ _
        , Optional ByVal sTableName$, Optional ByVal sOverExist As Boolean = False) As Boolean

    'On Error GoTo lbErr

    Dim iConcStr, iSql$, iFdlist$, iDb As ADODB.Connection
    Dim iI&, iFdType$, j, TmpField, FileName
    Dim iRe As Boolean
    '检查文件名
    If Dir(sExcelFileName) <> "" Then
        If sOverExist Then
            Kill sExcelFileName
        Else
            iRe = False
            GoTo lbExit
        End If
    End If

    '生成创建表的SQL语句
    With sRecordSet
        For iI = 0 To .Fields.Count - 1
            iFdType = f_FieldType(.Fields(iI).Type)
            Select Case iFdType
                Case "char", "varchar", "nchar", "nvarchar", "varbinary"
                    If .Fields(iI).DefinedSize > 255 Then
                        iSql = iSql & ",[" & .Fields(iI).Name & "] text"
                    Else
                        iSql = iSql & ",[" & .Fields(iI).Name & "] " & iFdType & _
                            "(" & .Fields(iI).DefinedSize & ")"
                    End If
                Case "image"
                Case Else
                    iSql = iSql & ",[" & .Fields(iI).Name & "] " & iFdType
            End Select
        Next

        If sTableName = "" Then sTableName = .Source
        iSql = "create table [" & sTableName & "](" & Mid(iSql, 2) & ")"
    End With

    '数据库连接字符串
    iConcStr = "DRIVER={Microsoft Excel Driver (*.xls)};DSN='';FIRSTROWHASNAMES=1;READONLY=FALSE;" & _
            "CREATE_DB=""" & sExcelFileName & """;DBQ=" & sExcelFileName

    '创建Excel文件,并创建表
    Set iDb = New ADODB.Connection
    iDb.Open iConcStr
    iDb.Execute iSql

    '插入数据
    With sRecordSet
        .MoveFirst
        While .EOF = False
            iSql = ""
            iFdlist = ""
            For iI = 0 To .Fields.Count - 1
                iFdType = f_FieldType(.Fields(iI).Type)
                If iFdType <> "image" And IsNull(.Fields(iI).Value) = False Then
                    iFdlist = iFdlist & ",[" & .Fields(iI).Name & "]"
                    Select Case iFdType
                        Case "char", "varchar", "nchar", "nvarchar", "text"
                            iSql = iSql & ",'" & .Fields(iI).Value & "'"
                        Case "datetime"
                            iSql = iSql & ",#" & .Fields(iI).Value & "#"
                        Case "image"
                        Case Else
                            iSql = iSql & "," & .Fields(iI).Value
                    End Select
                End If
            Next
            iSql = "insert into [" & sTableName & "](" & _
                Mid(iFdlist, 2) & ") values(" & Mid(iSql, 2) & ")"
            iDb.Execute iSql
            .MoveNext
        Wend
    End With    '处理完毕,关闭数据库
    iDb.Close
    Set iDb = Nothing

    MsgBox "已经将数据保存到 [ " & sExcelFileName & " ]", 64
    iRe = True
    GoTo lbExitlbErr:
    MsgBox "发生错误:" & Err.Description & vbCrLf & _
        "错误代码:" & Err.Number, 64, "错误"
lbExit:
    f_Export2Excel = iRe
End Function'得到所有数据类型,有些数据类型EXCEL不支持,已经替换掉
Public Function f_FieldType$(ByVal sType&)
    Dim iRe$
    Select Case sType
        Case 2, 3, 20
            iRe = "int"
        Case 5
            iRe = "float"
        Case 6
            iRe = "money"
        Case 131
            iRe = "numeric"
        Case 4
            iRe = "real"
        Case 128
            iRe = "binary"
        Case 204
           iRe = "varbinary"
        Case 11
            iRe = "bit"
        Case 129, 130
            iRe = "char"
        Case 17, 72, 131, 200, 202, 204
            iRe = "varchar"
        Case 201, 203
            iRe = "text"
        Case 7, 135
            iRe = "datetime"
        Case 205
            iRe = "image"
        Case 128
            iRe = "timestamp"
    End Select
    f_FieldType = iRe
End Function
'调用测试
Sub test()
    Dim iRe As ADODB.Recordset
    Dim iConc As String

    iConc = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
        ";Data Source=F:\My Documents\客户资料.mdb"

    Set iRe = New ADODB.Recordset
    iRe.Open "维护员", iConc, adOpenKeyset, adLockOptimistic
    f_Export2Excel iRe, "c:\b.xls", , True
    iRe.Close
End Sub

最简单的方法是直接用存储过程来实现：EXEC master..xp_cmdshell 'bcp TESTIINew.dbo.tmp out C:\test.xls -c -q -S "(local)" -U "sa" -P ""'用Connection连接对象直接运行即可:Conn.Excute SQL其中TESTIINew.dbo.tmp 表示要导出数据表表名称

谢谢！
看懂了！
能不能给我一些关于execl类的资料吗？

excel支持一种最简单的文本格式 XLS格式
文本文件的每一行对应excel当中的一行
一行当中不同的列对象之间用逗号分隔
从数据库转入这种格式最简单啦，只要会文本文件的读写，不用说你都知道如何做。

对象浏览器＋msdn 最好的资料
或者ide里按 F2 键即可

调试易

新来的！帮个忙吧！！

解决方案 »