Recordset To Excel

 
 
Transorm a recordset to an excel sheet
 
 
  1. Public Function RecordSetToExcel(Rs As ADODB.Recordset)

  2. Dim XL As Object ' Excel.Application '

  3. Dim objXLsheet As Object

  4. Dim i As Integer

  5. Dim j As Integer

  6. Const StartCol = 2

  7.    

  8.     On Error GoTo NoExcel

  9.     Set XL = CreateObject("Excel.Application")

  10.    

  11.     On Error GoTo LocalError

  12.     XL.Workbooks.Add

  13.     Set objXLsheet = XL.Worksheets(1)

  14.    

  15.     For i = 0 To Rs.Fields.Count - 1

  16.         objXLsheet.Cells(1, StartCol + i).Value = Rs.Fields(i).Name

  17.     Next i

  18.    

  19.     Rs.MoveFirst

  20.     If Rs.RecordCount = 0 Then Exit Function

  21.     Rs.MoveFirst

  22.     While Not Rs.EOF

  23.         j = j + 1

  24.         For i = 0 To Rs.Fields.Count - 1

  25.             objXLsheet.Cells(j + 1, i + StartCol).Value = Rs.Fields(i) 'col,row

  26.         Next i

  27.         Rs.MoveNext

  28.     Wend

  29.    

  30.     XL.Visible = True

  31.     objXLsheet.Select


  32.     Exit Function

  33. NoExcel:

  34.     MsgBox "Excel Application not Installed !"

  35.     Exit Function

  36. LocalError:

  37. ' your error handling here

  38.     'HandleError Err, OBJNAME, "RecordSetToExcel"

  39. End Function


 
Copy to Clipboard      Download code as Text Format
 
  Date entered : 17th Dec 2000
  Rating : No Rating
  Accessed  :  2189
  Submitted by :  Sagi
 
   Add Comment  Printer friendly
   View All Comments  Email to a friend
   Add to my Favourites Download PDF version
   Rating  
 
                 Click each image to add
this page to each site.
 
 
 
Comments Available

    No comment available at the moment.Be the first one to make a comment

 
Related Visual Basic Source Codes
  • Opening / Closing the CD Drive
  • Making a Form Topmost
  • Getting the Titlebars Color
  • Finding the Name of an Associated File Types Executable
  • Hiding an App from the CTRL-ALT-DEL Process List

  • Copyright © 2013 VisualBuilder. All rights reserved