Exporting query to Excel without saving

[mr moe]

hi guys, it's been a very long time .

I have copied this code from an old post. This code creates a query then it copies it to an excel sheet. The query works well when i open it manually, but the copy recordset and pasting to excel doesn't work. It opens excel empty. here is the code if someone can help please.





Dim MyDatabase As DAO.Database
Dim MyQueryDef As DAO.QueryDef
Dim MyRecordset As DAO.Recordset
Dim strSQL As String
Dim i As Integer

strSQL = "myquery"

'Step 2: Identify the database and query
Set MyDatabase = CurrentDb
On Error Resume Next
With MyDatabase
.QueryDefs.Delete ("tmpOutQry")
Set MyQueryDef = .CreateQueryDef("tmpOutQry", strSQL)
.Close
End With
'Step 3: Open the query
Set MyRecordset = MyQueryDef.OpenRecordset
'Step 4: Clear previous contents
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.Workbooks.Add
.Sheets("Sheet1").Select
'Step 5: Copy the recordset to Excel
.ActiveSheet.Range("A2").CopyFromRecordset MyRecordset
'Step 6: Add column heading names to the spreadsheet
For i = 1 To MyRecordset.Fields.Count
xlApp.ActiveSheet.Cells(1, i).Value = MyRecordset.Fields(i - 1).Name
Next i
xlApp.Cells.EntireColumn.AutoFit
End With

 

[Frothingslosh]

Please post the entire function - this is only part of it, and you're missing a bunch of stuff, including the variable declarations for things like xlApp. Also, please use code tags and proper spacing in order to make your code legible.

 

[mr moe]

Code:
Private Sub Command75_Click()
'Step 1: Declare your variables
Dim MyDatabase As DAO.Database
Dim MyQueryDef As DAO.QueryDef
Dim MyRecordset As DAO.Recordset
Dim strSQL As String
Dim i As Integer

strSQL = "SELECT theFields FROM theTableName WHERE someField = " & Me.ControlName & ";"
'Step 2: Identify the database and query
Set MyDatabase = CurrentDb
On Error Resume Next
With MyDatabase
.QueryDefs.Delete ("tmpOutQry")
Set MyQueryDef = .CreateQueryDef("tmpOutQry", strSQL)
.Close
End With
'Step 3: Open the query
Set MyRecordset = MyQueryDef.OpenRecordset
'Step 4: Clear previous contents
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.Workbooks.Add
.Sheets("Sheet1").Select
'Step 5: Copy the recordset to Excel
.ActiveSheet.Range("A2").CopyFromRecordset MyRecordset
'Step 6: Add column heading names to the spreadsheet
For i = 1 To MyRecordset.Fields.Count
xlApp.ActiveSheet.Cells(1, i).Value = MyRecordset.Fields(i - 1).Name
Next i
xlApp.Cells.EntireColumn.AutoFit
End With
End Sub


hope this helps. the xlApp is declared in step 4. i'm sorry as i said this is a code from another post. Everything seems to be working except the copy recordset. if this is missing a lot. could you direct me to some post that can help me.

 

[Frothingslosh]

You still haven't used code tags, which means your code is still much harder to read than it has to be.

 

[Frothingslosh]

Do you seriously have a control named ControlName, or have you edited that? What we need is the code as it exists in your project, since you said you have it mostly working. Also, the query you're posting isn't ever going to return records unless you have a table named "theTableName" with a field called "theFields", and another called "someField".

Again, please post the code FROM YOUR APPLICATION, not the post, and this time use code tags - (code) and (/code) but with square brackets - to save your indentation.

 

[Frothingslosh]

FYI, I'm about to leave work for the day, and I expect to get home in about 2 hours. I'll check this thread again once I get home.

 

[mr moe]

What is inside the strSQL is only an example, my real query is working and is being created. I can manualy check it and its working!!!! excel also opens as i want, but its empty. I can easily create a DoCmd.TransferSpreadsheet Method but I want to be able to creat it without saving or giving it a name sorry about the not including the tags, it's been years since i have used this. Ive been a member since 2003 btw

 

[Frothingslosh]

Honestly, I couldn't care less how long you've been a member, only that I asked for code tags and you refused to do it, and that I asked for the code AS IT APPEARS IN YOUR PROCEDURE and you refused to provide it.

You aren't saving the workbook, and you're not cleaning up.

Anything else I won't be able to help you with. Good luck with your project.

 

[JHB]

Your error handling prevent you to see when an error occurs, so comment out "On Error Resume Next".
I think the problem is the code line marked in red:

With MyDatabase
  .QueryDefs.Delete ("tmpOutQry")
  Set MyQueryDef = .CreateQueryDef("tmpOutQry", strSQL)
  [B][COLOR=Red].Close[/COLOR][/B]
End With

 

[mr moe]

And i could careless if you even try to help me again. You're even asking me for my query query fields loool so funny what does that do to you. This is my post and i dont expect yo to even reply back please leave my post. Thank you JHB for meaningfull reply.

 

[Frothingslosh]

FYI, it would be polite to click the Thanks button at the bottom-right of JHB's post for helping you.

Although a 13-year veteran board warrior would certainly know that by now.

 

[mr moe]

JHB your suggestion did help, after commenting the on error, the debugger is going to
"Set MyRecordset = MyQueryDef.OpenRecordset" with error msg Object Invalid. Thanks again. I know where to start.

 

[mr moe]

wow so interesting i was looking to do the same today and had to google and i saw this post that was created by me anyone has resolved it? btw thank you so much Frothingslosh i know it's very late to say it now, wow sometimes people realize their mistakes after so long

 

[Auntiejack56]

Replace this:

Set MyDatabase = CurrentDb
On Error Resume Next
With MyDatabase
.QueryDefs.Delete ("tmpOutQry")
Set MyQueryDef = .CreateQueryDef("tmpOutQry", strSQL)
.Close
End With
'Step 3: Open the query
Set MyRecordset = MyQueryDef.OpenRecordset

with this

On Error goto myErrorTrap
Set MyDatabase = CurrentDb
strsql = "SELECT * FROM [myquery];"
Set MyRecordset = MyDatabase.OpenRecordset(strsql,dbopensnapshot)

The real source of your troubles is the missing error trap. Never use On Error resume next unless you check for errors on the very next line, and then reset the error trap. That is, never do this:

On error resume next
Set dbs = Currentdb()
Set rs = dbs.openrecordset(strSQL,dbopensnapshot)
rs.MoveFirst

The following is ok, but only if you take extreme care:

On error Goto Catch_Error
Set dbs = Currentdb()
Set rs = dbs.openrecordset(strSQL,dbopensnapshot)
On error Resume Next
rs.movefirst
if Err <> 0 then
    Msgbox "No records"
End If
On error Goto Catch_Error

Jack

 

[mr moe]

Hi Jack,
thanks for help, it's still not working, it opens excel in as blank, i even made my query to one column with a normal field name but still, my problem is from copyfromrecordset its the excel part of my code that is not working i believe, im checking the tem query i'm creating and it had data in it. any advise? thanks.

 

[Auntiejack56]

JHB's answer is correct. Your .Close is closing the database object, so the recordset could not be created.
Jack

 

[Isaac]

Never use On Error resume next unless you check for errors on the very next line, and then reset the error trap

++1
Well said.