VB：怎样将查询结果导出到Excel

　　如果你想将查询结果导出到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中的内容为空，确保后面查询结果的正确导出。