怎樣將查詢結果導出到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中的內容為空，確保后面查詢結果的正確導出。

原文轉自：http://www.anti-gravitydesign.com