数据导出到EXCEL表中,我很急各位帮帮我!

Question

前面很多这样的问题了,自己search一下吧

Answer 1

http://dev.csdn.net/develop/article/18/18623.shtm

Answer 2

Public Sub ExporToExcel()
'若RecordSet建立出错，则转向RecordsetERR
On Error GoTo RecordSetERR
    
    myconn.Open
    myrecord.Open "select * from jhd where djh  >   '" & Text1.Text & "' and djh< '" & Text2.Text & "'", myconn
    
    Dim lngRowCount As Integer
    Dim lngColCount As Integer
    
    
    Dim ExcelAppX As Excel.Application
    Dim ExcelBookX As Excel.Workbook
    Dim ExcelSheetX As Excel.Worksheet
    Dim ExcelQueryX As Excel.QueryTable
    
    With myrecord
        If .State = adStateOpen Then
            .Close
        End If
        .ActiveConnection = myconn
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Source = "select * from jhd where djh  >   '" & Text1.Text & "' and djh< '" & Text2.Text & "'"
        .Open
    End With
    With myrecord
        If .RecordCount < 1 Then
            Call MsgBox("没有记录!", vbExclamation, "错误")
            myrecord.Close
            myconn.Close
            Exit Sub
        End If
        '记录总数
        lngRowCount = .RecordCount
        '字段总数
        lngColCount = .Fields.Count
    End WithOn Error GoTo ExcelERR
    '建立Excel应用程序
    Set ExcelAppX = CreateObject("Excel.Application")
    '建立WorkBook
    Set ExcelBookX = ExcelAppX.Workbooks().Add(App.path & "\jhd.xlt")
    '建立表格sheet1
    Set ExcelSheetX = ExcelBookX.Worksheets("sheet1")
    ExcelAppX.Visible = True
    
    '添加查询，填充Excel表格
    '注意此句！！！
    '从A3处向右下填充表格
    Set ExcelQueryX = ExcelSheetX.QueryTables.Add(myrecord, ExcelSheetX.Range("A3"))
    
    '查询设置
    With ExcelQueryX
        '是否显示字段名
        .FieldNames = False
        '是否显示行号
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        '后台搜索
        .BackgroundQuery = True
        '刷新样式
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        '是否保存数据
        .SaveData = True
        '是否自动调整列宽度
        .AdjustColumnWidth = False
        '自动刷新间距，设置为0是关闭自动刷新
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
    End With
    
    '进行查询
    ExcelQueryX.Refresh
    
    '设置字体和表格属性
    With ExcelSheetX
        .Range(.Cells(1, 1), .Cells(lngRowCount + 2, lngColCount)).Borders.LineStyle = xlContinuous
        '设表格边框样式
    End With
    
    
    '设置打印信息
    With ExcelSheetX.PageSetup
        .LeftHeader = "&""楷体_GB2312,常规""&10公司名称："
        .CenterHeader = "&""楷体_GB2312,常规""&10日期："
        .RightHeader = "&""楷体_GB2312,常规""&10单位："
        .LeftFooter = "&""楷体_GB2312,常规""&10制表人： " & username & "  "
        .CenterFooter = "&""楷体_GB2312,常规""&10制表日期：" & Date
        .RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页"
    End With
    
    ExcelAppX.Application.Visible = True
    ExcelSheetX.PrintPreview
    ExcelAppX.DisplayAlerts = False
    ExcelAppX.Quit
    Set ExcelAppX = Nothing  '"交还控制给Excel
    Set ExcelBookX = Nothing
    Set ExcelSheetX = Nothing
    myrecord.Close
    myconn.Close
    Exit SubConnectionERR:
    '错误处理程序
    MsgBox "数据库连接错误，" & Err.Description, vbCritical, "出错"
    Exit Sub
    
RecordSetERR:
    MsgBox "RecordSet生成错误，" & Err.Description, vbCritical, "出错"
    myrecord.Close
    Exit Sub
    
ExcelERR:
    MsgBox "填充Excel表格错误，" & Err.Description, vbCritical, "出错"
    If Not ExcelAppX Is Nothing Then ExcelAppX.Quit
    myrecord.Close
    myconn.CloseEnd Sub

Answer 3

select * into [Excel 8.0;DataBase=c:\ddd.xls].[sss] from table

Answer 4

http://www.mndsoft.com/blog/blogview.asp?logID=236http://www.mndsoft.com/blog/blogview.asp?logID=79以上仅作参考。