VB导出EXCEL问题,十万火急

solo_mm7 2004-10-10 11:00:37
小弟现使用VB,把STRING中的数据导出到EXCEL(STRING来源于SQL表,但是由于表中数据需要处理所以把表中内容读出再写如).现在使用CELL实现,但是速度很慢(40余字段,6K行).有没有更好的方法替代CELL?
再有,测试时使用TOP100条,可以正常输出,但是全部输出的时候却不能生成文件.为什么呢?(40余字段,6K行,其间需要对另一个13W条的数据库进行遍历从中取数据)
...全文
151 点赞 收藏 5
写回复
5 条回复
切换为时间正序
请发表友善的回复…
发表回复
GGL123 2004-10-10
怎样将查询结果导出到Excel
http://www.luntan.com.cn/info/1963356728696149.htm
回复
GGL123 2004-10-10
Visual Basic 导出到 Excel
http://code365.com/html/vb/20040302/index/200432101819.html
回复
solo_mm7 2004-10-10
因为数据源的问题,我这个只能写行或者写格不能直接把显示的表转换。只能通过程序逐行或者格写,有没有好办法啊?
回复
lujianyu1189 2004-10-10
我一般是使用mshflexgrid来显示要输出的数据,然后导出到EXECL就可以了,,好像还行..
回复
老汉 2004-10-10
工程中需要加入对MicroSoft Excel9.0 Object Library(excel9.olb)库的引用。
下面的函数我在SQL2K+WIN2K+OFFICE2K中进行了测试,测试表中含带两位小数的数值型字段。
调用格式:
if ExportTOExcel("TestTable","TestExcel")=False then
msgbox "Error"
end if


' 将strTName表中的数据全部导入到strFName文件中
' 入参:strTName-所要导出的数据表名称
' strFName-接收数据到EXCEL文件名称
' (如果该文件已经存在,那么无条件的删除掉该文件后重新创建新的文件)
' (strFName为主文件名,扩展文件名以及路径均在本函数中给出)
' 返回:TRUE-导出成功,FALSE-导出不成功
'------------------------------------------------
Public Function ExportTOExcel(strTName As String, strFName As String) As Boolean

On Error GoTo ErrLiner

Dim strSql As String ' SQL语句临时变量
Dim strTemp As String

Dim objXLS As Object ' OLE自动化对象
Dim rsTemp As ADODB.Recordset ' 所要导出数据的容器记录集

Dim intHeadCnt As Integer ' 记录集的字段数

ExportTOExcel = False

' 检测文件是否存在,如果已经存在,那么KILL掉
strFName = "C:\" & strFName & ".xls"
If Dir(strFName) <> "" Then Kill strFName

' 构造要导出数据的记录集[这里没有判断结果集为空的情况]
strSql = "Select * From " & strTName
Set rsTemp = HisConn.Execute(strSql, 2)

' 创建EXCEL对象
Set objXLS = CreateObject("Excel.Sheet.8")

' EXCEL工作表名称定义为所导出的表名
objXLS.Worksheets(1).Name = strTName

' 利用记录集的字段名构造表头
For intHeadCnt = 0 To rsTemp.Fields.Count - 1
objXLS.Worksheets(1).Cells(1, intHeadCnt + 1).Value = rsTemp(intHeadCnt).Name
Next

' 第一行标题字体置为粗体
objXLS.Worksheets(1).Range(objXLS.Worksheets(1).Cells(1, 1), objXLS.Worksheets(1).Cells(1, rsTemp.Fields.Count)).Font.Bold = True
rsTemp.MoveFirst

' 向Excel文档输出数据[利用CopyFromRecordset属性来拷贝数据内容,有效的提高数据导出的速度]
'' objXLS.Worksheets(1).Cells.CopyFromRecordset rsTemp
objXLS.Worksheets(1).Range("A2").CopyFromRecordset rsTemp '保留了前面添加上去的第一行,从第二行开始进行数据复制

' EXCEL文档保存
objXLS.SaveAs strFName

' 注销对象空间
objXLS.Application.Quit: Set objXLS = Nothing: Set rsTemp = Nothing

'' ' 打开数据
'' If ChkAutoOpen.Value = 1 Then
''
'''' On Error Resume Next
'' '--------------------------------------------------------------------C:\Microsoft Office2000\Office
'' Shell "C:\Program Files\Microsoft Office\Office\excel.exe C:\" & strFName & ".xls", vbMaximizedFocus
'' Shell "D:\Program Files\Microsoft Office\Office\excel.exe C:\main1.xls", vbMaximizedFocus
'' Shell "C:\Microsoft Office2000\Office\excel.exe C:\" & strFName & ".xls", vbMaximizedFocus
'' End If

ExportTOExcel = True: Exit Function

ErrLiner:
Debug.Print Err.Description & Err.Number 'test

End Function



回复
发动态
发帖子

1180

社区成员

VB 数据库(包含打印,安装,报表)
申请成为版主
社区公告
暂无公告