将查询结果导出excel 里

http://topic.csdn.net/t/20040610/09/3079154.html

解决方案 »

  1.   

    <%
    DatabasePath="db1.mdb"
    Set Conn=Server.CreateObject("Adodb.Connection")
    Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath(DatabasePath)Class ExcelGen 
    Private objSpreadsheet 
    Private iColOffset 
    Private iRowOffset Sub Class_Initialize() 
    Set objSpreadsheet = Server.CreateObject("OWC.Spreadsheet") 
    iRowOffset = 2 
    iColOffset = 2 
    End Sub Sub Class_Terminate() 
    Set objSpreadsheet = Nothing 'Clean up 
    End Sub Public Property Let ColumnOffset(iColOff) 
    If iColOff > 0 then 
    iColOffset = iColOff 
    Else 
    iColOffset = 2 
    End If 
    End Property Public Property Let RowOffset(iRowOff) 
    If iRowOff > 0 then 
    iRowOffset = iRowOff 
    Else 
    iRowOffset = 2 
    End If 
    End Property Sub GenerateWorksheet(objRS) 
    'Populates the Excel worksheet based on a Recordset's contents 
    'Start by displaying the titles 
    If objRS.EOF then Exit Sub 
    Dim objField, iCol, iRow 
    iCol = iColOffset 
    iRow = iRowOffset 
    For Each objField in objRS.Fields 
    objSpreadsheet.Cells(iRow, iCol).Value = objField.Name 
    objSpreadsheet.Columns(iCol).AutoFitColumns 
    '设置Excel表里的字体 
    objSpreadsheet.Cells(iRow, iCol).Font.Bold = True 
    objSpreadsheet.Cells(iRow, iCol).Font.Italic = False 
    objSpreadsheet.Cells(iRow, iCol).Font.Size = 10 
    objSpreadsheet.Cells(iRow, iCol).Halignment = 2 '居中 
    iCol = iCol + 1 
    Next 'objField 
    'Display all of the data 
    Do While Not objRS.EOF 
    iRow = iRow + 1 
    iCol = iColOffset 
    For Each objField in objRS.Fields 
    If IsNull(objField.Value) then 
    objSpreadsheet.Cells(iRow, iCol).Value = "" 
    Else 
    objSpreadsheet.Cells(iRow, iCol).Value = objField.Value 
    objSpreadsheet.Columns(iCol).AutoFitColumns 
    objSpreadsheet.Cells(iRow, iCol).Font.Bold = False 
    objSpreadsheet.Cells(iRow, iCol).Font.Italic = False 
    objSpreadsheet.Cells(iRow, iCol).Font.Size = 10 
    End If 
    iCol = iCol + 1 
    Next 'objField 
    objRS.MoveNext 
    Loop 
    End Sub Function SaveWorksheet(strFileName) 
    'Save the worksheet to a specified filename 
    On Error Resume Next 
    Call objSpreadsheet.ActiveSheet.Export(strFileName, 0) 
    SaveWorksheet = (Err.Number = 0) 
    End Function 
    End Class Dim objRS 
    Set objRS = Server.CreateObject("ADODB.Recordset") 
    objRS.Open "SELECT * FROM info", conn,1,1
    Dim SaveName 
    SaveName = "aaa1"'Request.Cookies("savename")("name") Dim objExcel 
    Dim ExcelPath 
    ExcelPath =SaveName & ".xls" ' "Excel\" & SaveName & ".xls" 
    Set objExcel = New ExcelGen 
    objExcel.RowOffset = 1 
    objExcel.ColumnOffset = 1 
    objExcel.GenerateWorksheet(objRS) 
    If objExcel.SaveWorksheet(Server.MapPath(ExcelPath)) then 
    Response.Write "<html><body bgcolor='gainsboro' text='#000000'>已保存为Excel文件. <a href='" & server.URLEncode(ExcelPath) & "'>下载</a></body></html>" 
    Else 
    Response.Write "在保存过程中有错误!" 
    End If 
    Set objExcel = Nothing 
    objRS.Close 
    Set objRS = Nothing 
    %>
      

  2.   

    直接导出到CSV格式的EXCEL文件是最简单的了,逗号分割列，回车分割行