怎样将查询结果导出到Excel

发布时间：2008-04-03 10:39:15  来源：Blog  作者：Blog  点击：309

因为我是个菜鸟，所以我写的文章都是给那些刚入门的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中的内容为空，确保后面查询结果的正确导出。