Captured Technology

Export and ADO Recordset to Excel

Jan 29 2009

Export and ADO Recordset to Excel

If you're in need to taking an ADO Recordset from an Access Database of a .Net Application and saving that data programmatically to an Excel file, the following procedure will do a very good job of completing the conversion.

By Steve Patterson

You can modify the SaveAs command towards the end of the function to save the file in a different location with a different name or you can add the value as a parameter to the subroutine. There is also a Visible flag near the end of the procedure which will show the Excel file after it is created. This would also be a very good value to pass into the subroutine.

Private Sub ExportToExcel(ByVal rs As ADODB.Recordset)
 
    Dim oApp As New Excel.Application
    Dim oBook As Excel.Workbook
    Dim oWorkSheet As Excel.Worksheet
    Dim oField As ADODB.Field
    Dim c As Long
    Dim i As Long
    
    On Error GoTo ErrorHandler
 
    Set oBook = oApp.Workbooks.Add
    Set oWorkSheet = oBook.Worksheets.Item(1)
    
    oApp.Visible = False
    
    With oWorkSheet
        c = Asc("A")
        For Each oField In rs.Fields
            .Range(Chr(c) & "1").Value = oField.Name
            .Range(Chr(c) & "1").Font.Bold = True
            c = c + 1
        Next
        
        i = 2
        If rs.RecordCount > 0 Then rs.MoveFirst
        While Not rs.EOF
            c = Asc("A")
            For Each oField In rs.Fields
                .Range(Chr(c) & i).Value = rs(oField.Name)
                c = c + 1
            Next
            i = i + 1
            rs.MoveNext
        Wend
    End With
    
    oWorkSheet.SaveAs "c:\temp\temp.xls"
    'oApp.Visible = True
    oApp.Quit
    
    GoTo CleanExit
 
ErrorHandler:
    MsgBox Err.Number & ": " & Err.Description
 
CleanExit:    
    If Not oApp Is Nothing Then Set oApp = Nothing
    If Not oBook Is Nothing Then Set oBook = Nothing
    If Not oWorkSheet Is Nothing Then Set oWorkSheet = Nothing
 
End Sub

Blog Directory

Latest technology news.
 Steve Patterson
 411  245414  5/16/2017

FaceBook

Translate

Sponsors





Blog Calendar

Categories