Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

ADO Recordset to Excel 3

Status
Not open for further replies.

Mute101

Programmer
Jun 28, 2001
428
GB
I have an updated ADO recordset that i would like to push into a new excel book. Is this possible or do i need to store my recordset in a temp table and pull data from there?

Reason:

I am creating an excel file to mail to a customer and I change the data so it is more readable for said customer but i dont need the new style data. Therefore i need to create a recordset, change data, export then throw away changes.

Any input on this greatly appreciated.
 
In Access97 and Excel97 I export a Query to an Excel file which has a macro to format the sheet. I run the Excel macro from the Access VBA code. As this is purely internal the Access does the e-mail to confirm the new file is in the Share. The Excel macro is based on a Recorded macro with the file save name created from the date and a (slightly) meaningful prefix.

If this sounds like what you need I can post the Access code I use. You'll have to do your own Excel code as that will be specific to your requirements. Sandy
 
Sure please do post that code.

Any fresh ideas are good ideas at the moment as I am melting my brain trying to get things to work with ADO.
 
This code does the export to the Excel File

TemplateFile = "O:\Foldername\SpreadsheetName.XLS"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "qryExportExcel", TemplateFile, False


This code will run an Excel Macro, You may need to tweak it as it is Access97.

On Error Resume Next
Dim mno As String
Set XLApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Set XLApp = CreateObject(&quot;Excel.Application&quot;)
End If
On Error GoTo Err_DoBTOne
TemplateFile = &quot;O:\Foldername\SpreadsheetName.XLS&quot;
On Error Resume Next
XLApp.workbooks.Open TemplateFile
f = RunMacro(&quot;FormatFont&quot;)
XLApp.Application.Quit

Set XLApp = Nothing



Sandy
 
I think this MS Knowledge Base article might help with the E-MAil side of things

Q153311 Sandy
 
Thanks but my company uses Groupwise and I have created a module to deal with email side of the problem using DDE.

I think you may have missed the main point of my question but I like the macro code you have printed and I never thought of doing anything like that before.

The main question I need answering is:

Is it possible to take a recordset and use ADOs ability to read/write to excel to push the data into a spreadsheet.

The only code I have come across requires an SQL string to pull the data ie.

Code:
Dim strSQL As String
strSQL = &quot;SELECT * INTO [Excel 8.0;Database=&quot; & App.Path & _ 
    &quot;\book1.xls].[Sheet1] FROM Customers&quot;
cnSrc.Execute strSQL

Any ideas?
 
Yes, it is totally possible to push data from Access into an Excel Spreadsheet, in fact you can specify the sheets and cells if you like. Below is a section of code I pulled out of an app. It is for reference only, feel free to slice and dice as necessary. It is lengthy, but everything you need to push data to Excel is in it. This was from a module, and I used some constants, you can if you want, but don't have to.

====================================
' Constants
Private Const XLS_LOCATION As String = &quot;C:\My Documents\Spreadsheets\Vault.xlt&quot;
Private Const XLT_LOCATION As String = &quot;C:\Windows\Vault.xlt&quot;
Private Const MC_START_ROW As Integer = 299
Private Const MC_END_ROW As Integer = 100
Private Const VISA_START_ROW As Integer = 999
Private Const VISA_END_ROW As Integer = 800

Public Sub populateExcel()
On Error GoTo Populate_Err
Dim rs As Recordset
Dim objXL As Object, objSheet As Object, objRange As Object
Dim strSaveAs As String, strVISA As String, strMC As String
Dim x As Integer, intRow As Integer

DoCmd.Hourglass True

' Set the SQL strings for the two recordsets that will be opened
strVISA = &quot;SELECT [Card Style], [Start Inventory] FROM [qryworking inventory start] WHERE [Plastic Type] = 'VISA'&quot;
strMC = &quot;SELECT [Card Style], [Start Inventory] FROM [qryworking inventory start] WHERE [Plastic Type] = 'MC'&quot;

' Open, and make visible the Excel Template (Vault.xlt) which resides on the desktop
Set objXL = GetObject(XLT_LOCATION)
objXL.Application.Visible = True
objXL.Parent.windows(1).Visible = True

' Open the VISA recordset, and activate the VISA sheet in the template
Set rs = CurrentDb.OpenRecordset(strVISA, dbOpenSnapshot)
Set objSheet = objXL.Worksheets(&quot;Visa&quot;)
objSheet.Activate
rs.MoveFirst
x = 4

' Insert the data from the VISA recordset into the VISA worksheet
Do Until rs.EOF
objXL.ActiveSheet.Cells(x, 1).Value = rs![Card Style]
objXL.ActiveSheet.Cells(x, 2).Value = rs![Start Inventory]
x = x + 1
rs.MoveNext
Loop

' Delete all unnecessary rows making the VISA worksheet only as long as it needs to be
intRow = VISA_START_ROW
With objSheet
.select
Do Until intRow = VISA_END_ROW
If .Range(&quot;A&quot; & intRow).Value = &quot;&quot; Then
Set objRange = .Range(&quot;A&quot; & intRow & &quot;:B&quot; & intRow & &quot;:C&quot; & intRow & &quot;:D&quot; & intRow & &quot;:E&quot; & intRow _
& &quot;:F&quot; & intRow & &quot;:G&quot; & intRow & &quot;:H&quot; & intRow & &quot;:I&quot; & intRow & &quot;:J&quot; & intRow _
& &quot;:K&quot; & intRow & &quot;:L&quot; & intRow & &quot;:M&quot; & intRow & &quot;:N&quot; & intRow & &quot;:O&quot; & intRow & &quot;:p&quot; & intRow)
objRange.Delete 'Shift:=objXLUp
End If
intRow = intRow - 1
Loop
End With
rs.Close

' Open the MC recordset, and activate the MC sheet in the template
Set rs = CurrentDb.OpenRecordset(strMC, dbOpenSnapshot)
Set objSheet = objXL.Worksheets(&quot;MC&quot;)
objSheet.Activate
rs.MoveFirst
x = 4

' Insert the data from the MC recordset into the MC worksheet
Do Until rs.EOF
objXL.ActiveSheet.Cells(x, 1).Value = rs![Card Style]
objXL.ActiveSheet.Cells(x, 2).Value = rs![Start Inventory]
x = x + 1
rs.MoveNext
Loop

' Delete all unnecessary rows making the MC worksheet only as long as it needs to be
intRow = MC_START_ROW
With objSheet
.select
Do Until intRow = MC_END_ROW
If .Range(&quot;A&quot; & intRow).Value = &quot;&quot; Then
Set objRange = .Range(&quot;A&quot; & intRow & &quot;:B&quot; & intRow & &quot;:C&quot; & intRow & &quot;:D&quot; & intRow & &quot;:E&quot; & intRow _
& &quot;:F&quot; & intRow & &quot;:G&quot; & intRow & &quot;:H&quot; & intRow & &quot;:I&quot; & intRow & &quot;:J&quot; & intRow _
& &quot;:K&quot; & intRow & &quot;:L&quot; & intRow & &quot;:M&quot; & intRow & &quot;:N&quot; & intRow & &quot;:O&quot; & intRow & &quot;:p&quot; & intRow)
objRange.Delete
End If
intRow = intRow - 1
Loop
End With

' Calculate totals on spreadsheet
objXL.Application.calculate

' Set the save string, and save the spreadsheet
strSaveAs = &quot;C:\Windows\Desktop\&quot; & Format(DATE, &quot;mmddyyyy&quot;) & &quot;.xls&quot;
objXL.SaveCopyAs strSaveAs

' Quit Excel
objXL.Application.DisplayAlerts = False
objXL.Application.Quit

Set objXL = Nothing
Set objSheet = Nothing
Set objRange = Nothing
Set rs = Nothing

Populate_Exit:
DoCmd.Hourglass False
Exit Sub

Populate_Err:
MsgBox Err.Number & &quot;: &quot; & Err.Description
GoTo Populate_Exit
End Sub
Jim Lunde
compugeeks@hotmail.com
We all agree your theory is crazy, but is it crazy enough?
 
Thankyou peeps for your input, I have already started something similar to this but as I have just found out the joys of ADO I thought I might be able to do everything without exposing excel.

In hindsight I think the method you have posted will probably be the best option.

Thanks for the code, I havent really used the excel object too much so that makes things a bit easier.
 
If the database isn't secured the 'Pull' method from Excel works quite well. One of the most recent advances is the CopyFromRecordset method of a Worksheet. Merely connect, create and ADO recordset, and CopyToRecordset will do a lot of the iterative work.

Steve King

Public Function CreateReportFromQueryADO(Optional DbPath As String, _
Optional ReportTitle As String, Optional SQL_Query As String) As Boolean

Dim cnnConn As ADODB.Connection
Dim rstRecordset As ADODB.Recordset
Dim cmdCommand As ADODB.Command
Dim ws As Worksheet

On Error Resume Next

' Open the connection.
Set cnnConn = New ADODB.Connection
With cnnConn
.ConnectionString = _
&quot;Provider=Microsoft.Jet.OLEDB.4.0&quot;
.Open DefaultDbPath
End With

' If the DbPath was provided verify it
' otherwise open from the default database.
If Len(DbPath) > 0 Then
' Check to verify that the database exists at the location stated
' in the input parameter
If Len(Dir(DbPath)) > 0 Then
With cnnConn
.ConnectionString = _
&quot;Provider=Microsoft.Jet.OLEDB.4.0&quot;
.Open DbPath
End With
Else
MsgBox &quot;Invalid database path (&quot; & DbPath & &quot;)&quot;
Exit Function
End If
Else
If Len(Dir(DefaultDbPath)) > 0 Then
With cnnConn
.ConnectionString = _
&quot;Provider=Microsoft.Jet.OLEDB.4.0&quot;
.Open DefaultDbPath
End With
Else
MsgBox &quot;Invalid database path (&quot; & DbPath & &quot;)&quot;
Exit Function
End If
End If

On Error GoTo HandleErr

' Set the command text.
Set cmdCommand = New ADODB.Command
Set cmdCommand.ActiveConnection = cnnConn
With cmdCommand
.CommandText = SQL_Query
.CommandType = adCmdText
.Execute
End With

' Open the recordset.
Set rstRecordset = New ADODB.Recordset
Set rstRecordset.ActiveConnection = cnnConn
rstRecordset.Open cmdCommand

'Worksheets.Add Count:=1, Before:=Sheets(1)
Set ws = Worksheets(1)

For iCols = 0 To rstRecordset.Fields.Count - 1
ws.Cells(1, iCols + 1).Value = rstRecordset.Fields(iCols).Name
Next

ws.Range(ws.Cells(1, 1), _
ws.Cells(1, rstRecordset.Fields.Count)).Font.Bold = True
ws.Range(&quot;A2&quot;).CopyFromRecordset rstRecordset

NameTheWorkbook (ReportTitle)

Exit_Proc:
On Error Resume Next
' Close the connections and clean up.
cnnConn.Close
Set cmdCommand = Nothing
Set rstRecordset = Nothing
cnnConn.Close
Set cnnConn = Nothing
Exit Function

HandleErr:
MsgBox &quot;Error: &quot; & Err.Number & vbCrLf & &quot;Description: &quot; & Err.Description _
& vbCrLf & &quot;CreateReportFromQueryADO&quot;
Resume Exit_Proc
Resume
End Function Growth follows a healthy professional curiosity
 
Great this is what i was after.

Thanks so much for all your help [thumbsup]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top