ASP实现Access与Excel的数据转换，要实现此功能，需要两步来实现，第一步，从Access数据库中读取内容，第二步，将读取到的内容按指定格式输出到Excel文件中。

ASP导出数据到Excel（可定义导出样式）代码

<%




server.scripttimeout=100000 '若处理时间比较长，可将值设置大一点




On Error Resume Next




set objExcelApp = CreateObject("Excel.Application")




objExcelApp.DisplayAlerts = false




objExcelApp.Application.Visible = false




objExcelApp.WorkBooks.add




set objExcelBook = objExcelApp.ActiveWorkBook




set objExcelSheets = objExcelBook.Worksheets




set objSpreadsheet = objExcelBook.Sheets(1)




Dim Conn




Dim Connstr




Dim DB




DB="weste.mdb" '选择数据库




Set conn = Server.CreateObject("ADODB.Connection")




Connstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(DB)




Conn.Open Connstr




Dim objRS




Set objRS = Server.CreateObject("ADODB.Recordset")




objRS.Open "SELECT * FROM FriendLink",conn,1,3 '先用sql语句查询需要导出的内容




If objRS.EOF then




 response.write("Error")




 respose.end




End if




Dim objField, iCol, iRow




iCol = 1  '取得列号




iRow = 1 '取得行号




objSpreadsheet.Cells(iRow, iCol).Value = "用ASP将Access中的数据导入到Excel文件"  '单元格插入数据




objSpreadsheet.Columns(iCol).ShrinkToFit=true  '设定是否自动适应表格单元大小(单元格宽不变）




'设置Excel表里的字体




objSpreadsheet.Cells(iRow, iCol).Font.Bold = True  '单元格字体加粗




objSpreadsheet.Cells(iRow, iCol).Font.Italic = False  '单元格字体倾斜




objSpreadsheet.Cells(iRow, iCol).Font.Size = 20  '设置单元格字号




objSpreadsheet.Cells(iRow, iCol).ParagraphFormat.Alignment=1 '设置单元格对齐格式:居中




objspreadsheet.Cells(iRow,iCol).font.name="宋体" '设置单元格字体




objspreadsheet.Cells(iRow,iCol).font.ColorIndex=2 '设置单元格文字的颜色，颜色可以查询，2为白色




objSpreadsheet.Range("A1:F1").merge   '合并单元格(单元区域)




objSpreadsheet.Range("A1:F1").Interior.ColorIndex = 1 '设计单元络背景色




'objSpreadsheet.Range("A2:F2").WrapText=true 设置字符回卷（自动换行）




iRow=iRow+1




For Each objField in objRS.Fields




'objSpreadsheet.Columns(iCol).ShrinkToFit=true




objSpreadsheet.Cells(iRow, iCol).Value = objField.Name




'设置Excel表里的字体




objSpreadsheet.Cells(iRow, iCol).Font.Bold = True




objSpreadsheet.Cells(iRow, iCol).Font.Italic = False




objSpreadsheet.Cells(iRow, iCol).Font.Size = 20




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 = 1




For Each objField in objRS.Fields




If IsNull(objField.Value) then




objSpreadsheet.Cells(iRow, iCol).Value = ""




Else




objSpreadsheet.Columns(iCol).ShrinkToFit=true




objSpreadsheet.Cells(iRow, iCol).Value = objField.Value




objSpreadsheet.Cells(iRow, iCol).Halignment = 2




objSpreadsheet.Cells(iRow, iCol).Font.Bold = False




objSpreadsheet.Cells(iRow, iCol).Font.Italic = False




objSpreadsheet.Cells(iRow, iCol).Font.Size = 10




'objSpreadsheet.Cells(iRow, iCol).Halignment = 2




objSpreadsheet.Cells(iRow, iCol).ParagraphFormat.Alignment=1




End If




iCol = iCol + 1




Next    'objField




objRS.MoveNext




Loop




Dim SaveName




SaveName="temp1"




Dim objExcel




Dim ExcelPath




ExcelPath = "" & SaveName & ".xls"




objExcelBook.SaveAs server.mappath(ExcelPath)




response.write("<a href='" & server.URLEncode(ExcelPath) & "'>下载</a>")




objExcelApp.Quit




set objExcelApp = Nothing




%>