Solved

Saving to a File from ADO RECORDSET

Posted on 2001-07-03
10
534 Views
Last Modified: 2007-12-19
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
Comment
Question by:ramsmv
  • 3
  • 2
  • 2
  • +3
10 Comments
 
LVL 1

Expert Comment

by:Sieger
ID: 6249668
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
 
LVL 69

Expert Comment

by:Éric Moreau
ID: 6249739
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
 
LVL 22

Expert Comment

by:rspahitz
ID: 6249745
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
 
LVL 28

Accepted Solution

by:
iboutchkine earned 25 total points
ID: 6249995
'***************************************************************
' 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
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 6249998
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
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 5

Expert Comment

by:rkot2000
ID: 6250161
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
 
LVL 69

Expert Comment

by:Éric Moreau
ID: 6263090
ramsmv, have you piked your choice?
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 6263551
rkot2000, copyfromrecordset accepts ADO recordsets?
0
 
LVL 5

Expert Comment

by:rkot2000
ID: 6265044
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
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 6266971
Arrrg!, why using "as object"?
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

706 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now