如何将记录集直接保存成EXCEL文件

xuedaniel 2005-08-05 09:38:11
VB中如何将记录集直接保存成EXCEL文件?急用。谢谢!
...全文
262 6 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
6 条回复
切换为时间正序
请发表友善的回复…
发表回复
henry_gz 2005-08-21
  • 打赏
  • 举报
回复
Use Method CopyFromRecordset


Example
------------------------
Private Sub cmdLoad_Click()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim excel_app As Excel.Application
Dim excel_sheet As Excel.Worksheet

Screen.MousePointer = vbHourglass
DoEvents

' Open the Access database.
Set conn = New ADODB.Connection
conn.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & txtAccessFile.Text
conn.Open

' Select the Access data.
Set rs = conn.Execute("Books")

' Create the Excel application.
Set excel_app = CreateObject("Excel.Application")

' Uncomment this line to make Excel visible.
' excel_app.Visible = True

' Open the Excel workbook.
excel_app.Workbooks.Open txtExcelFile.Text

' Check for later versions.
If Val(excel_app.Application.Version) >= 8 Then
Set excel_sheet = excel_app.ActiveSheet
Else
Set excel_sheet = excel_app
End If

' Use the Recordset to fill the table.
excel_sheet.Cells.CopyFromRecordset rs
excel_sheet.Cells.Columns.AutoFit

' Save the workbook.
excel_app.ActiveWorkbook.Save

' Shut down.
excel_app.Quit
rs.Close
conn.Close

Screen.MousePointer = vbDefault
MsgBox "Ok"
End Sub
奔跑9999 2005-08-08
  • 打赏
  • 举报
回复
打開Excel直接寫入即可阿!
xuedaniel 2005-08-08
  • 打赏
  • 举报
回复
这样效率太低了呵
xuedaniel 2005-08-08
  • 打赏
  • 举报
回复
如果是自己使用就很简单,关键我是要做成程序的方式给用户,有错误时叫用户导出数据给我看呵。
zuoxingyu 2005-08-08
  • 打赏
  • 举报
回复
我曾经尝试过一个比较方便的办法来解决
1:把你的记录查询语句复制到SQL查询分析器里,执行查询,得到结果
2:把得到的结果写如一个临时表里,
3:其实1,2可以放到一起写的。。右击这个临时表,选择所有任务,然后选择导出数据,进入导出数据向导,选择导出到EXCEL,里面有很多可以选择的。]
4:完成操作
of123 2005-08-05
  • 打赏
  • 举报
回复
使用CopyFromRecordset语句,可以直接把记录集写入Excel工作表。
使用DAO的用意是支持Excel 97;如果使用ADO记录集,则仅支持Excel 2000。
下面是完整的例子:

Dim db As dao.Database
Dim rs As dao.Recordset
Dim fd As dao.Field
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim cellCnt As Integer

' Open the destination Excel workbook.
Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.add
Set xlSheet = xlBook.ActiveSheet

xlBook.PrintPreview
' Open the recordset.
Set db = DBEngine.Workspaces(0).OpenDatabase(App.Path & "\bmkq.mdb")
Set rs = db.OpenRecordset("SELECT ......")
' Title
xlSheet.Cells(1, 1).Value = "考勤汇总表"
' Tabel Heads
cellCnt = 1
For Each fd In rs.Fields
Select Case fd.Type
Case dbBinary, dbGUID, dbLongBinary, dbVarBinary
' This type of data can't export to excel
Case Else
xlSheet.Cells(2, cellCnt).Value = fd.Name
xlSheet.Cells(2, cellCnt).Interior.ColorIndex = 33
xlSheet.Cells(2, cellCnt).Font.Bold = True
xlSheet.Cells(2, cellCnt).BorderAround xlContinuous
cellCnt = cellCnt + 1
End Select
Next
' This is all it takes to copy the contents
' of the recordset into the first worksheet
' of Book1.xls.
xlBook.Worksheets(1).Range("A3").CopyFromRecordset rs
xlApp.ActiveWindow.DisplayZeros = False

xlBook.Worksheets(1).Range("A3").Select

xlApp.Visible = True
' Clean up everything.
'xlBook.Save
'xlBook.Close False
'xlApp.Quit
rs.Close
db.Close
'Set xlBook = Nothing
'Set xlApp = Nothing
Set rs = Nothing
Set db = Nothing
exitsub:

1,217

社区成员

发帖
与我相关
我的任务
社区描述
VB 数据库(包含打印,安装,报表)
社区管理员
  • 数据库(包含打印,安装,报表)社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧