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 SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Export Query Results to Excel w/ Code 3

Status
Not open for further replies.

slaga9

Technical User
Jun 8, 2007
46
0
0
CA
I am trying to export the results of a query to excel.
I have my current code posted below.
with this...I can export the query as set up in the wizard to excel with no problems, however I want to be able to Query with parameters (ie select a date range, or specific employee) and then export that to excel.

What should I add, and where (I'm a pretty big novice!)

any help is much appreciated.
-Sean-

Option Compare Database


Public Function ExportRequest() As String
On Error GoTo err_Handler

' Excel object variables
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet

Dim sTemplate As String
Dim sTempFile As String
Dim sOutput As String

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sSQL As String
Dim lRecords As Long
Dim iRow As Integer
Dim iCol As Integer
Dim iFld As Integer

Const cTabTwo As Byte = 1
Const cStartRow As Byte = 11
Const cStartColumn As Byte = 1

DoCmd.Hourglass True

' set to break on all errors
Application.SetOption "Error Trapping", 0

' start with a clean file built from the template file
' sTemplate = CurrentProject.Path & "\salary recovery template.xls"
sOutput = CurrentProject.Path & "\salary recovery template.xls"
' If Dir(sOutput) <> "" Then Kill sOutput
' FileCopy sTemplate, sOutput

' Create the Excel Applicaiton, Workbook and Worksheet and Database object
Set appExcel = Excel.Application
Set wbk = appExcel.Workbooks.Open(sOutput)
Set wks = appExcel.Worksheets(cTabTwo)


sSQL = "SELECT Employee_ID.[Account Name], Employee_ID.[Gen Ledg Acnt No], "
sSQL = sSQL & "Timesheettable1.[Job Number], Employee_ID.Type, Employee_ID.unknown, "
sSQL = sSQL & "Employee_ID.[Ref No], Employee_ID.[Recovery No], Timesheettable1.Employee, "
sSQL = sSQL & "Employee_ID.Rate, Timesheettable1.[Hours Worked], Timesheettable1.[Hours Paid]"
sSQL = sSQL & " FROM Employee_ID INNER JOIN Timesheettable1 ON Employee_ID.Employee = Timesheettable1.Employee;"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
If Not rst.BOF Then rst.MoveFirst

' For this template, the data must be placed on the 11th row, first column.
' (these values are set to constants for easy future modifications)
iCol = cStartColumn
iRow = cStartRow


Do Until rst.EOF
iFld = 0
lRecords = lRecords + 1
' Me.lblMsg.Caption = "Exporting record #" & lRecords & " to salary recovery template.xls"
' Me.Repaint

For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
wks.Cells(iRow, iCol) = rst.Fields(iFld)

If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
wks.Cells(iRow, iCol).NumberFormat = "mm/dd/yyyy"
End If

wks.Cells(iRow, iCol).WrapText = False
iFld = iFld + 1
Next

wks.Rows(iRow).EntireRow.AutoFit
iRow = iRow + 1
rst.MoveNext
Loop

ExportRequest = "Total of " & lRecords & " rows processed."
' Me.lblMsg.Caption = "Total of " & lRecords & " rows processed."

exit_Here:
' Cleanup all objects (resume next on errors)
On Error Resume Next
Set wks = Nothing
Set wbk = Nothing
Set appExcel = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
Exit Function

err_Handler:
ExportRequest = Err.Description
' Me.lblMsg.Caption = Err.Description
Resume exit_Here

End Function

Private Sub cmdsearch_Click()
On Error GoTo err_Handler

MsgBox ExportRequest, vbInformation, "Finished"
Application.FollowHyperlink CurrentProject.Path & "\salary recovery template.xls"

exit_Here:
Exit Sub
err_Handler:
MsgBox Err.Description, vbCritical, "Error"
Resume exit_Here
End Sub
 
Slaga9,

For a simple parameter just create a name encompassed with [] whice isn't an already existing field in the Employee_ID and Timesheettable tables. Use these in the WHERE clause of your SELECT statement. For example you can use [Enter Employee ID] and [Begin Date] with [End Date].

If you need something more complex like a dropdown combo box you'll have to create the a form, have the user enter data and use a button call the export code.

If possible, I'd keep it simple.

-Neema
 
...or use a form to collect the filter criteria and pass it to your routine. This will allow all the criteria to be specified (and validated) at one time instead of hitting the user with numerous parameter dialog boxes.
Code:
Public Function ExportRequest(Optional WhereClause As String) As String
...
   sSQL = sSQL & " FROM Employee_ID" & _
          " INNER JOIN Timesheettable1" & _
          " ON Employee_ID.Employee =" & _
          " Timesheettable1.Employee"
   If Len(WhereClause) = 0 Then
      sSQL = sSQL & ";"
   Else
      sSQL = sSQL & WhereClause & ";"
   End if
...

On a different subject you may want to take a look at the [tt]CopyFromRecordset()[/tt] method of the Excel object instead of a row/column loop. It runs a lot faster and you can specify the range of where you want the data to dumped in the worksheet.

Hope this helps,
CMP

[small]For the best results do what I'm thinking, not what I'm saying.[/small]
(GMT-07:00) Mountain Time (US & Canada)
 
thank you both very much for the response, I really appreciate any help I am able to get from this site.

I think for what I need to acomplish CautionMP's method is the best approach.

CautionMP if its not too much trouble I have some questions for you and all your ms access glory!!

Currently I have set up the form with a parameter queries with drop down boxes.
there is 1 command button which runs the query. everything works well, there is a wildcard setting, it is gold. it all takes place on the form, and the user does not get all those pesky prompt boxes.

So I think to handle the export
I would now like to add a second command button that exports it to excel file called
salaryrecoverytemplate.xls I need the data to be entered into row A11 because of formatting.


I hate to be of bother, but as you probably have noticed am pretty new with this stuff, so I need some pretty in-depth instruction, your help would be greatly appreciated.
If you are able to, please include how I can impliment your recommended way of importing the data.

thanks
Sean



 
slaga9,
If the form contains the filtered records that you want exported to Excel you could use something like this for the On Click event of your second command buuton:
Code:
   On Error GoTo err_Handler
   Const cTabTwo As Byte = 1
   ' Excel object variables
   Dim appExcel As Excel.Application
   Dim wbk As Excel.Workbook
   Dim wks As Excel.Worksheet
   Dim sOutput As String
    
   DoCmd.Hourglass True
   
   ' set to break on all errors
   Application.SetOption "Error Trapping", 0
   
   ' start with a clean file built from the template file
   sOutput = CurrentProject.Path & "\salary recovery template.xls"
   
   ' Create the Excel Applicaiton, Workbook and Worksheet and Database object
   Set appExcel = Excel.Application
   Set wbk = appExcel.Workbooks.Open(sOutput)
   Set wks = appExcel.Worksheets(cTabTwo)
   [b][green]'Take the records in the current form and dump to Excel[/green]
   wks.Range("[i]A11[/i]").CopyFromRecordset Me.Recordset[/b]
  
exit_Here:
   ' Cleanup all objects  (resume next on errors)
   On Error Resume Next
   Set wks = Nothing
   [b][green]'You may want to save the workbook here[/green][/b]
   Set wbk = Nothing
   Set appExcel = Nothing
   DoCmd.Hourglass False
   Exit Function
   
err_Handler:
   ExportRequest = Err.Description
   ' Me.lblMsg.Caption = Err.Description
   Resume exit_Here

(I just wordsmithed your original post so I appologize for any syntax errors.)

Hope this helps,
CMP

[small]For the best results do what I'm thinking, not what I'm saying.[/small]
(GMT-07:00) Mountain Time (US & Canada)
 
Thank you very much for the response CautionMP.

I am getting an error

Run-Time error '5' Invalid procedure name.
with the
wks.Range("A11").CopyFromRecordset Me.Recordset
line highlited in the debugger.

I am not certain, but I think I may have miss comunicated my current set up.

The first comand button (filterquery) runs the query (paraquery) which is controlled by drop down boxes on the form.
the results of that query pop up in a datasheet type veiw.

I am not sure but in that code do I need to reference the query? or am I making a different error?


thanks again for your help, it is really appreicated!
Sean
 
slaga9 said:
...results of that query pop up in a datasheet type veiw.

As in a seperate window in Access (not within the calling form), or said differently your Form is unbound (has no Recordset associated with it?

If this is the case using [tt]Me.Recordset[/tt] in the code is probably causing the error since the form ([tt]Me[/tt]) doens't have a recordset.

Since the parameters for the query appear to be coming from the open form you should be able to create a object variable to hold the query and use that in place of [tt]Me.Recordset[/tt]
Code:
   On Error GoTo err_Handler
   Const cTabTwo As Byte = 1
   ' Excel object variables
   Dim appExcel As Excel.Application
   Dim wbk As Excel.Workbook
   Dim wks As Excel.Worksheet
   [b]Dim rstOutput As DAO.Recordset[/b]
   Dim sOutput As String
    
   DoCmd.Hourglass True
   
   ' set to break on all errors
   Application.SetOption "Error Trapping", 0

   [b]Set rstOutput = CurrentBd.OpenRecordset("[i]query name here[/i]")[/b]
   
   ' start with a clean file built from the template file
   sOutput = CurrentProject.Path & "\salary recovery template.xls"
   
   ' Create the Excel Applicaiton, Workbook and Worksheet and Database object
   Set appExcel = Excel.Application
   Set wbk = appExcel.Workbooks.Open(sOutput)
   Set wks = appExcel.Worksheets(cTabTwo)
   'Take the records in the current form and dump to Excel
   wks.Range("A11").CopyFromRecordset [b]rstOutput[/b]
  
exit_Here:
   ' Cleanup all objects  (resume next on errors)
   On Error Resume Next
   Set wks = Nothing
   'You may want to save the workbook here
   Set wbk = Nothing
   Set appExcel = Nothing
   [b]rstOutput.Close
   Set rstOutput = nothing[/b]
   DoCmd.Hourglass False
   Exit Function
   
err_Handler:
   ExportRequest = Err.Description
   ' Me.lblMsg.Caption = Err.Description
   Resume exit_Here

Hope this helps,
CMP

[small]For the best results do what I'm thinking, not what I'm saying.[/small]
(GMT-07:00) Mountain Time (US & Canada)
 
Thanks again for the response CautionMP!

unfortunately I again did not have much luck.
I changed
Set rstOutput = CurrentBd.OpenRecordset("query name here")
to
set rstOutput = CurrentDb.OpenRecordset("paraquery")

The first error I recieved was regarding the exit function, saying "compile error, exit function not allowed in sub or property"

I decided to try tabbing in that line to see what came up, the next error msg I recieved was runtime error 3061.

Im wondering, do I need to reference the sql statment for the query at all??

is there any additional information I could provide you with to better assit me?

sorry for all the questions, I really appreciate the help, and again must apologize for my lack of know how!
atleast im learning right? lol

thanks again
Sean

 
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Dim rstOutput As DAO.Recordset

Set db = CurrentDb
Set qdf = db.QueryDefs("paraquery")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rstOutput = qdf.OpenRecordset

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
First off...a HUGE thank you to both of you! you've both been so helpful!

Today I finally got the application to work!! sort of...

but it worked...and that’s what’s important!

So what happens is...I click on it. and it looks like nothing happens. excel doesn’t pop up.

But...if I go into the template file through the shortcut, It says "salary recovery template is already open, opening it again will disregard any changes made".... when I click no, the file opens up with the imported data!

I am assuming I need to do some cleaning up of the code.
I would assume I have some stuff in there which I probably dont need, and given that excel isnt poping up, I probably have screwed something up.

Any advice on how to get this running smoother?
Thanks again!!


Private Sub exportcmd_Click()
On Error GoTo err_Handler
Const cTabTwo As Byte = 1
' Excel object variables

Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Dim rstOutput As DAO.Recordset
Dim sOutput As String

Set db = CurrentDb
Set qdf = db.QueryDefs("paraquery")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rstOutput = qdf.OpenRecordset

DoCmd.Hourglass True

' set to break on all errors
Application.SetOption "Error Trapping", 0

' start with a clean file built from the template file
sOutput = CurrentProject.Path & "\salary recovery template.xls"

' Create the Excel Applicaiton, Workbook and Worksheet and Database object
Set appExcel = Excel.Application
Set wbk = appExcel.Workbooks.Open(sOutput)
Set wks = appExcel.Worksheets(cTabTwo)
'Take the records in the current form and dump to Excel
wks.Range("A11").CopyFromRecordset rstOutput

exit_Here:
' Cleanup all objects (resume next on errors)
On Error Resume Next
Set wks = Nothing
'You may want to save the workbook here
Set wbk = Nothing
Set appExcel = Nothing
rstOutput.Close
Set rstOutput = Nothing
DoCmd.Hourglass False
' Exit exportcmd_Click

err_Handler:
ExportRequest = Err.Description
' Me.lblMsg.Caption = Err.Description
'Resume exit_Here
End Sub
 
Near the end of the subroutine you'll find the comment "[green]You may want to save the workbook here[/green]". You should put a line to save the workbook there, for example:

Code:
wbk.Save

OR

wbk.SaveAs("yourfilename")


-V
 
I'd use this:
appExcel.Visible = True

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
awsome guys!
everything works!
You can bet I will be mentioning a donation on behalf of our company at the next meeting! You all have really helped me out!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top