• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 646
  • Last Modified:

Saving to a File from ADO RECORDSET

I need to save the details of a recordset directly
into a .xls file(Excel File).Is there any method in
ADO Recordset which supports this.

I would appreciate an immediate answer.
0
ramsmv
Asked:
ramsmv
  • 3
  • 2
  • 2
  • +3
1 Solution
 
SiegerCommented:
You may just do a loop through the recordset and write out a comma-delimited file.  Then you may load that file into excel.
0
 
Éric MoreauSenior .Net ConsultantCommented:
You can use this small sub:

Public Sub SaveRecordset(ByVal prstData As ADODB.Recordset, _
                         Optional ByVal pstrFileName As String)
Dim intFF As Integer
Dim intI As Integer
Dim strMessage As String

    If Len(Trim$(pstrFileName)) = 0 Then pstrFileName = App.Path & "\log.csv"
   
    intFF = FreeFile
    Open pstrFileName For Output As #intFF
   
    For intI = 0 To prstData.Fields.Count - 1
        strMessage = strMessage & prstData.Fields(intI).Name & ", "
    Next intI
    Print #intFF, strMessage
   
    Do Until prstData.EOF
        strMessage = ""
        For intI = 0 To prstData.Fields.Count - 1
            strMessage = strMessage & prstData.Fields(intI).Value & ", "
        Next intI
        Print #intFF, strMessage
        prstData.MoveNext
    Loop
   
    Close #intFF   ' Close file.
End Sub
0
 
rspahitzCommented:
I don't think recordsets convert directly to Excel.
Either try as Sieger suggested (the simple way) or try adding the Excel reference to your project and have it access the Excel engine directly to transfer the info (the direct way)
0
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
iboutchkineCommented:
'***************************************************************
' Name: modExcel.bas
' Description:Copies a recordset into an Excel spreadsheet and then displays the results for user interaction.
'
' Inputs:Sn - Recordset to copy
strCaption - Name to assign to the created worksheet
'
' Returns:Nothing
'
'Assumes:You must add a reference to the Excel 8.0 Object Library
'     and DAO Object Library for this code to work properly. This has been tested on dynaset type recordsets
'and Excel97 only.
'
' User defined type to help determine the
' starting cell in the range receiving the recordset


Private Type ExlCell
    row As Long
    col As Long
    End Type


Private Sub CopyRecords(rs As Recordset, ws As Worksheet, StartingCell As ExlCell)
'-------------------------------------------------------------------------------
    Dim SomeArray() As Variant
    Dim row As Long, col As Long
    Dim fd As Field

    ' You might want to check if rs is not empty
    rs.MoveLast
    ReDim SomeArray(rs.RecordCount + 1, rs.Fields.Count)
    ' Copy column headers to array
    col = 0

    For Each fd In rs.Fields
        SomeArray(0, col) = fd.Name
        col = col + 1
    Next
    ' Copy rs to some array
    rs.MoveFirst

    For row = 1 To rs.RecordCount - 1
        For col = 0 To rs.Fields.Count - 1
            SomeArray(row, col) = rs.Fields(col).Value
            ' Excel will be offended if you try setting one
            ' of its cells to a NULL
            If IsNull(SomeArray(row, col)) Then _
            SomeArray(row, col) = ""
        Next
        rs.MoveNext
    Next

    ' The range should have the same number of
    ' rows and cols as in the recordset
    ws.Range(ws.Cells(StartingCell.row, StartingCell.col), _
    ws.Cells(StartingCell.row + rs.RecordCount + 1, _
    StartingCell.col + rs.Fields.Count)).Value = SomeArray
End Sub



Sub ToExcel(Sn As Recordset, strCaption As String)
'-------------------------------------------------------------------------------
    Dim oExcel As Object
    Dim objExlSht As Object' OLE automation object
    Dim stCell As ExlCell

    DoEvents
        On Error Resume Next
        Set oExcel = GetObject(, "Excel.Application")
        ' If Excel is not launched start it


        If Err = 429 Then
            Err = 0
            Set oExcel = CreateObject("Excel.Application")
            ' Can't create object


            If Err = 429 Then
                MsgBox Err & ": " & Error, vbExclamation + vbOKOnly
                Exit Sub
            End If

        End If

        oExcel.Workbooks.Add
        oExcel.Worksheets("sheet1").Name = strCaption
        Set objExlSht = oExcel.ActiveWorkbook.Sheets(1)
        stCell.row = 1
        stCell.col = 1
        ' Place the fields across the top of the spreadsheet:
        CopyRecords Sn, objExlSht, stCell
        ' Give the user control
        oExcel.Visible = True
        oExcel.Interactive = True
        ' Clean up:
        Set objExlSht = Nothing ' Remove object variable.
        Set oExcel = Nothing' Remove object variable.
        Set Sn = Nothing ' Remove snapshot object.
    End Sub
0
 
Richie_SimonettiIT OperationsCommented:
I would like to post a "twist" to previous comment:
(I used nwind.mdb that comes with VS to do the example,change values accordingly):

Option Explicit

Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Private Sub Form_Click()
Screen.MousePointer = vbHourglass
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
Dim filename As String

With cnn
    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\archivos de programa\microsoft visual studio\vb98\nwind.mdb;persist security info=false"
    .Open
End With

With rs
    Dim ff As Integer
    ff = FreeFile
    filename = "c:\data.txt"
    .Open "select * from clientes order by idcliente", cnn, adOpenDynamic, adLockOptimistic
    Open filename For Output As #ff
        Dim fld As ADODB.Field, header As String
        For Each fld In .Fields
            header = header & fld.Name & vbTab
        Next
       Print #ff, Mid$(header, 1, Len(header) - 1)
       Print #ff, .GetString
    Close #ff
       
End With
Screen.MousePointer = vbNormal
End Sub

Optionally, you could use this to export to Excel (With a previous reference to it and corresponding objects variables:

Workbooks.OpenText FileName:="C:\data.txt", Origin:=xlWindows, StartRow:= _
        1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
        Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
        Array(10, 1), Array(11, 1))
0
 
rkot2000Commented:
You can use CopyFromRecordset (build in function from excel library) to copy all records.

Or you can use GetString(ADO recodset method) to get comma delimited string and save that string to *.csv

Using for i=0 to records.count bad idea.


  Dim ljxlApp As Object
  Dim ljxlBook As Object
  Dim ljxlSheet As Object
   
  Dim lvlSheets As Long
  Dim lvlColumn  As Long

  'Dim ljBus As Apccprsb.CSrch
  Dim ljrsData As ADOR.Recordset

  On Error GoTo Error_

  'Set ljBus = MMain_.GetBusSrch()

  Set ljrsData = GetBusSrch.RegExcl(lvsSortBy)

  Set ljxlApp = VBA.CreateObject("Excel.Application")
  lvlSheets = ljxlApp.SheetsInNewWorkbook
  ljxlApp.SheetsInNewWorkbook = 1
  Set ljxlBook = ljxlApp.Workbooks.Add
  If lvlSheets > 0 Then
       ljxlApp.SheetsInNewWorkbook = lvlSheets
  End If
  Set ljxlSheet = ljxlBook.Sheets(1)
 
  For lvlColumn = 0 To ljrsData.Fields.Count - 1
      ljxlSheet.Cells(1, lvlColumn + 1).Value = ljrsData.Fields(lvlColumn).Name
  Next

  ljxlSheet.Range(ljxlSheet.Cells(1, 1), _
  ljxlSheet.Cells(1, ljrsData.Fields.Count)).Font.Bold = True

  ljxlSheet.Range("A2").CopyFromRecordset ljrsData
0
 
Éric MoreauSenior .Net ConsultantCommented:
ramsmv, have you piked your choice?
0
 
Richie_SimonettiIT OperationsCommented:
rkot2000, copyfromrecordset accepts ADO recordsets?
0
 
rkot2000Commented:
to Richie_Simonetti  yes it does.
this is from my program :

Private Sub ExportToExcel(lvsSortBy As String)
  Dim ljxlApp As Object
  Dim ljxlBook As Object
  Dim ljxlSheet As Object
   
  Dim lvlSheets As Long
  Dim lvlColumn  As Long

  'Dim ljBus As Apccprsb.CSrch
  Dim ljrsData As ADOR.Recordset

  On Error GoTo Error_

  Set ljrsData = GetBusSrch.RegExcl(lvsSortBy)

  Set ljxlApp = VBA.CreateObject("Excel.Application")
  lvlSheets = ljxlApp.SheetsInNewWorkbook
  ljxlApp.SheetsInNewWorkbook = 1
  Set ljxlBook = ljxlApp.Workbooks.Add
  If lvlSheets > 0 Then
  ljxlApp.SheetsInNewWorkbook = lvlSheets
  End If
  Set ljxlSheet = ljxlBook.Sheets(1)
  ljxlSheet.Name = "Prs Report"
 

  For lvlColumn = 0 To ljrsData.Fields.Count - 1
      ljxlSheet.Cells(1, lvlColumn + 1).Value = ljrsData.Fields(lvlColumn).Name
  Next

  ljxlSheet.Range(ljxlSheet.Cells(1, 1), _
  ljxlSheet.Cells(1, ljrsData.Fields.Count)).Font.Bold = True


  ljxlSheet.Range("A2").CopyFromRecordset ljrsData
 
  ljrsData.Close
  Set ljrsData = Nothing



  'reset selection
  ljxlSheet.Range("A1").Select
 
  ljxlApp.WindowState = -4137 ' = xlMaximized
  ljxlApp.Visible = True
   
Exit_:
Exit Sub
Error_:
  ShowError Me.Name, "ExportToExcel "
  Set ljrsData = Nothing
  SetMouse
End Sub
0
 
Richie_SimonettiIT OperationsCommented:
Arrrg!, why using "as object"?
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

  • 3
  • 2
  • 2
  • +3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now