Exporting data to Excel 4

[cjac]

Hi, does anyone know if it possible to export the contents of a recordset to Excel, ie. without binding the recordset to a datagrid or flexi grid and then exporting the contents from the datagrid/flexigrid? I'm not sure if this is possible but if it is it would certainly cut down on code. If this is not possible I guess I will have to open a hidden flexi grid, export the contents of the recorset into the grid and then export from the grid to Excel. Any ideas...?

Cheers!

 

[x508]

This example takes a recordset, and from it, creates a new recordet in an excel file, which can then be opened in excel

***************************************************

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpszOp As String, _
ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal LpszDir As String, ByVal FsShowCmd As Long) _
As Long
Private Const SW_NORMAL = 1

Public Function ExpExcel_Out()

On Error Resume Next
Kill App.Path & "\temp.xls"

On Error GoTo 0

Dim oConn As Connection
Set oConn = New Connection
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\temp.xls;" & _
"Extended Properties=""Excel 8.0;HDR=NO;"""


oConn.Execute "create table Data (OrderNumber text, Barcode text, Item text, Description text, College text,[Group] Text, [Date] text, [Time] text, Supplier Text, UnitCost Number);"


Dim oRS As Recordset
Set oRS = New Recordset
oRS.Open "Select * from Data", oConn, adOpenKeyset, adLockOptimistic

Do While Not (rs.EOF)
oRS.AddNew
oRS.Fields(0) = rs.Fields("OrderNumber&quot
oRS.Fields(1) = rs.Fields("Barcode&quot
oRS.Fields(2) = rs.Fields("Item&quot
oRS.Fields(3) = rs.Fields("Description&quot
oRS.Fields(4) = rs.Fields("College&quot
oRS.Fields(5) = rs.Fields("Group&quot
oRS.Fields(6) = rs.Fields("Date&quot
oRS.Fields(7) = rs.Fields("Time&quot
oRS.Fields(8) = rs.Fields("Supplier&quot
oRS.Fields(9) = rs.Fields("UnitCost&quot

oRS.Update
rs.MoveNext
DoEvents
Loop

oRS.Close
oConn.Close

DoEvents
ShellExecute frmDetailedEnqSUP_on.hwnd, "Open", App.Path & "\temp.xls", "", "C:\", SW_SHOWNORMAL

End Function

**********************************
May the Code Be With You...
----------
x50-8 (X Fifty Eigt)

 

[cjac]

thanks for that x508. I have now got my RS going into the temp XL file. ALthough instead of the file just sitting in the directory, is there anyway to open the file within the same code, ie. without having a seperate routine to open the tmp file?

Cheers

 

[x508]

ShellExecute frmDetailedEnqSUP_on.hwnd, "Open", App.Path & "\temp.xls", "", "C:\", SW_SHOWNORMAL

This will open the temp.xls file in Excell as soon as you have transfered your recordset

**********************************
May the Code Be With You...
----------
x50-8 (X Fifty Eigt)

 

[x508]

Did you get it right

**********************************
May the Code Be With You...
----------
x50-8 (X Fifty Eigt)

 

[pmrankine]

Just another suggestion, if recordset is from access ....

    Dim objExcelApp As Excel.Application
    Dim xlsExcelSheet As Excel.Worksheet

    ' Create the Excel application.
    Set objExcelApp = New Excel.Application
    objExcelApp.Visible = False

    ' Add the Excel spreadsheet.
    objExcelApp.Workbooks.Add
    
    ' Check for later versions.
    If Val(objExcelApp.Application.Version) >= 8 Then
        Set xlsExcelSheet = objExcelApp.Worksheets(1) 
    Else
        Set xlsExcelSheet = objExcelApp
    End If

    ' Open the Access database.
    Set conn = New ADODB.Connection
    conn.ConnectionString = _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & strAccessDB & ";" & _
        "Persist Security Info=False"
    conn.Open

    ' Select the data.
    Set rs = conn.Execute( _
        "SELECT * FROM tblCorporateSales", , _
        adCmdText)

    ' Make the column headers.
    For col = 0 To rs.Fields.Count - 1
        xlsExcelSheet.Cells(1, col + 1) = rs.Fields(col).Name
    Next col

    ' Get data from the database and insert
    ' it into the spreadsheet.
    row = 2
    Do While Not rs.EOF
        For col = 0 To rs.Fields.Count - 1
            xlsExcelSheet.Cells(row, col + 1) = rs.Fields(col).value
        Next col

        row = row + 1
        rs.MoveNext
    Loop

    ' Close the database.
    rs.Close
    Set rs = Nothing
    conn.Close
    Set conn = Nothing

pmrankine

 

[cjac]

Cheers for that, although Excel still does not open for some reason. I've since added the following to open the temp file:
Public Sub XL_Open() 'Open a tmp file in Excel
Dim m_objExcel As Excel.Application
Dim m_objWorkbook As Excel.Workbook

Set m_objExcel = New Excel.Application
m_objExcel.Visible = True

m_objExcel.DisplayAlerts = False
Set m_objWorkbook = m_objExcel.Workbooks.Open(Cdir & Cfilename, True, True, , "&quot

End Sub

This required adding of the MS XL9.0 OLB and worked fine until I added the MS Scripting Runtime which I'm using for the filesystem object for some directory cleanups elsewhere.
No it's falling over with "Could not find installable ISAM" !!!
I'll start a new thread to see if anyone know the quick solution to this!

Thanks for the help.

 

[cjac]

cheers pmrankine - that works a treat. I've just taken out the access stuff as I'm connecting to Oracle. I've already got an RS prepared in another procedure that I'm reading into my Excel_Out procedure. This is a very tidy way of outputting an RS to Excel.

Thanks once again.

 

[ablackwe]

pmrankine - I found your post really helpful, however, does anyone know a way of making the process quicker? This does it cell by cell but I am currently exporting tables that could have in excess of 15,000 rows. It would be helpful if I could do this in a bulk process.

 

[Swi]

blackwa,

Try this using your connection object:

Dim conn As ADODB.Connection
Set conn = New ADODB.Connection

conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\YOURFILENAME.mdb"
conn.Open

conn.Execute "SELECT * INTO [Excel 8.0;" & _
"Database=C:\YOURFILENAME.XLS].[Sheet1] FROM " & _
"YOURTABLENAME", num_copied

Swi

 

[ablackwe]

Cheers Swi for this, however, I do get the following error

Server: Msg 2760, Level 16, State 1, Line 1
Specified owner name 'C:\Test.xls' either does not exist or you do not have permission to use it.

Any ideas?

Adam

 

[Swi]

Does the file exist or is it open by another application?

Swi

 

[ablackwe]

It is created and not open by anything else

Ads

 

[Swi]

Is 'C:\Test.xls' the actual path or are you trying to access a network drive that you may not have permissions to?

Swi

 

[ablackwe]

This is the actual path. I initially tried doing it to a network drive but thought the same thing so I changed it

Ads

 

[Swi]

This is a very strange dilemma. I have tried the below code numerous times and it has worked:

Private Sub Command1_Click()
Dim conn As ADODB.Connection
Dim num_copied As Long

Set conn = New ADODB.Connection

conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\UsersDB.mdb"
conn.Open

If Dir$("C:\Test.xls") <> vbNullString Then Kill "C:\Test.xls"

conn.Execute "SELECT * INTO [Excel 8.0;" & _
"Database=C:\Test.xls].[Sheet1] FROM " & _
"Test", num_copied

conn.Close
Set conn = Nothing

MsgBox "Export Complete!", vbInformation
End Sub

Maybe someone else has some input on the matter. I am interested as to what is causing the issue.

Swi

 

[ablackwe]

The tables I have are in SQL Server. I've got the connection string different and I know that it works as I have used it for other things. I'm not sure whether this will have anything to do with it but I wouldn't have thought so.

Ads

 

[Swi]

It should not have anything to do with it but could you post the code so I can take a look at it?

Swi

 

[VBrit]

The fastest way to do this is by loading your data into an array, and then loading the array into your worksheet.

Bear in mind that the maximum number of rows in a worksheet is 32768 so you need to use mod function to split across multiple worksheets.

look up array and excel worksheet in msdn for sample code.

This is superfast!

 

[Swi]

Actually the max number of rows in a worksheet is 65,536. I would assume that the method using ADO would be faster as it eliminates the array step but I could be wrong. Some testing would be needed to prove which one is faster.

Swi