中国IT动力,最新最全的IT技术教程
最新100篇 | 推荐100篇 | 专题100篇 | 排行榜 | 搜索 | 在线API文档
首 页 | 程序开发 | 操作系统 | 软件应用 | 图形图象 | 网络应用 | 精文荟萃 | 教育认证 | 硬件维护 | 未整理篇 | 站长教程
ASP JS PHP工程 ASP.NET 网站建设 UML J2EESUN .NET VC VB VFP 网络维护 数据库 DB2 SQL2000 Oracle Mysql
服务器 Win2000 Office C DreamWeaver FireWorks Flash PhotoShop 上网宝典 CorelDraw 协议大全 网络安全 微软认证
硬件维护  CPU  主板  硬盘  内存  显卡  显示器  键盘鼠标  声卡音箱  打印机  机箱电源  BIOS  网卡  C#  Java  Delphi  vs.net2005
  当前位置:> 程序开发 > 编程语言 > Visual Basic > 综合文章
怎样将查询结果导出到Excel
作者:未知 时间:2004-03-24 12:12 出处:Blog 责编:chinaitpower
              摘要:怎样将查询结果导出到Excel
 

因为我是个菜鸟,所以我写的文章都是给那些刚入门的vb新手看的。呵呵,没什么深度。欢迎大家评论!

如果你想将查询结果导出到Excel另存,以便日后查看或打印的话,那么我这里说的就是怎样将查询结果导出到Excel。先来写一个函数FillDataArray,该函数的主要作用是将查询语句中的字段名和查到的记录导入到Excel中。

Public Function FillDataArray(asArray(), adoRS As ADODB.Recordset) As Long

'将数据送 Excel 函数

Dim nRow As Integer

Dim nCol As Integer

On Error GoTo FillError

ReDim asArray(100000, adoRS.Fields.Count)

nRow = 0

    For nCol = 0 To adoRS.Fields.Count - 1

        asArray(nRow, nCol) = adoRS.Fields(nCol).Name

    Next nCol

    nRow = 1

Do While Not adoRS.EOF

    For nCol = 0 To adoRS.Fields.Count - 1

        asArray(nRow, nCol) = adoRS.Fields(nCol).Value

    Next nCol

    adoRS.MoveNext

    nRow = nRow + 1

Loop

nRow = nRow + 1

FillDataArray = nRow

Exit Function

FillError:

  MsgBox Error$

  Exit Function

  Resume

End Function

然后再来写一个过程PrintList,来调用前面的这个函数。

Private Sub PrintList()

Dim strSource, strDestination As String

Dim asTempArray()

Dim INumRows As Long

Dim objExcel As Excel.Application

Dim objRange As Excel.Range

On Error GoTo ExcelError

Set objExcel = New Excel.Application '新建一个Excel

Dim rs As New ADODB.Recordset

Set rs = Conn.Execute(sqlall)‘sqlall是查询语句

If Not rs.EOF Then

     objExcel.Workbooks.Open App.Path & "\vvv.xls"

     MsgBox "查询结果导出后,请将其另存为一个.xls文件,使vvv.xls中的内容为空,确保后面查询结果的正确导出。"

    INumRows = FillDataArray(asTempArray, rs) '调填充数组函数

    objExcel.Cells(1, 1) = "查询结果"    '填表头

    Set objRange = objExcel.Range(objExcel.Cells(2, 1), objExcel.Cells(INumRows, rs.Fields.Count))

    objRange.Value = asTempArray                  '填数据

 

End If

    objExcel.Visible = True                      '显示Excel

    objExcel.DisplayAlerts = True                '提示保存Excel

    Exit Sub

ExcelError:

  If Err <> 432 And Err > 0 Then

    MsgBox Error$

    Set objExcel = Nothing

    Exit Sub

  Else

    Resume Next

  End If

End Sub

其中用到的vvv.xls必须是先建好了的xls文件。结果导出后不要直接保存,而要将其另存为一个.xls文件,使vvv.xls中的内容为空,确保后面查询结果的正确导出。

关闭本页
 
首页 | 投资与合作 | 服务条款 | 隐私政策 | 收藏本站 | 设为首页 | 新用户注册 | 免责声明 | 使用帮助
Copyright ©2005-2008 chinaitpower.com All rights reserved. www.chinaitpower.com 版权所有