Export Query To Excel With Multiple Criteria (2 Viewers)

Sevn

I trust ME!
Local time
Today, 10:39
Joined
Mar 13, 2008
Messages
97
Hello All,

I am working on an export module, that I can't seem to figure out.

My project:'
I have a form that has 2 combo boxes, and one "Go" button.
Company, VolCat​
Within the VolCat combo box, I have eight unique items, and an "ALL" item.
The ALL items references a "*", so I may grab all records.​

I have a parameter query that is based on the combo box inputs.

I have a XLS template with 8 worksheets. The 8 worksheets are named based on the 8 different categories within field "VolCat" (1A, 1B, 1C, 1D, 2A, 2B, 2C, 2D)

When the "Go" button is pressed, I would like my query to be exported (not viewed) to Excel. I would like the records to export to their appropriate worksheet based on the value found in the "VolCat" field. So; if someone selects "ALL" from the combo box, all of the records will be directly exported to Excel to the correct worksheet. If someone selects VolCat "2A", then only the 2A worksheet will be populated upon run-time.
This is where I am having issues.​

I currently have a separate query for each category, that are exported one at a time into a single workbook...RUNS VERY SLOW. Also; I will need this same type of setup for a few different reports, so I will end up making 8 queries for each report. This is not good, since I have 6+ reports. I don't think 48 queries is the best way of doing this.

If someone could send me some sample code, or lead me in the right direction, it would be greatly appreciated.

I'm assuming that there is a way that I can query/export in one VBA command.

Such as:
DoCmd.OutputTo acOutputQuery,"ExportQry-CPMByCompany", acFormatXLS, "file loc" WHERE "VolCat" = "1A" (To Worksheet 1A)
DoCmd.OutputTo acOutputQuery,"ExportQry-CPMByCompany", acFormatXLS, "file loc" WHERE "VolCat" = "1B" (To Worksheet 1B)
ETC...

This would allow me to have 1 query, but achieve the same results I need.

Thanks,
Sevn
 

chergh

blah
Local time
Today, 15:39
Joined
Jun 15, 2004
Messages
1,414
You can't specify location using outputto or transferspreadsheet methods. Look at the copyfromrecordset method if you need to do it this way.
 

Sevn

I trust ME!
Local time
Today, 10:39
Joined
Mar 13, 2008
Messages
97
Hello,

Thanks for your response, but I am a very novice user when it comes to VBA. Can you provide an example for further explanation. In most cases; I can understand what the code is saying, and can modify as I see fit.

Thanks,
Sevn:D
 

chergh

blah
Local time
Today, 15:39
Joined
Jun 15, 2004
Messages
1,414
Add excel references and use the following code to copy your data from your table to excel.

Code:
dim xlapp as excel.application
dim wb as excel.workbook
dim ws as excel.worksheet

dim rs as recordset

set xlapp = new excel.application
set wb = xlapp.workbooks.open("c:\whatever.xls")
set ws = wb.worksheets("1A")

set rs = currentdb.openrecordset("ExportQry-CPMByCompany")

ws.range("A1").copyfromrecordset rs

set rs = nothing
set ws = nothing
set wb = nothing
set xlapp = nothing
 
Last edited:

Sevn

I trust ME!
Local time
Today, 10:39
Joined
Mar 13, 2008
Messages
97
Hello, and thanks again for your response.

Please confirm that I understand your logic correctly. I believe you have given me the basic code needed to accomplish the export to Excel. So; I should just need a CASE statement to tell Access what worksheet to export to run.

Example:

dim xlapp as excel.application
dim wb as excel.workbook
dim ws as excel.worksheet

dim rs as recordset
Select Case (value of VolCat combo box)

Case 1A
set xlapp = new excel.application
set wb = xlapp.workbooks.open("file loc")
set ws = wb.worksheets("1A")

set rs = currentdb.openrecordset("ExportQry-CPMByCompany")

ws.range("A1").copyfromrecordset rs

set rs = nothing
set ws = nothing
set wb = nothing
set xlapp = nothing

Case 1B
set xlapp = new excel.application
set wb = xlapp.workbooks.open("file loc")
set ws = wb.worksheets("1B")

set rs = currentdb.openrecordset("ExportQry-CPMByCompany")

ws.range("A1").copyfromrecordset rs

set rs = nothing
set ws = nothing
set wb = nothing
set xlapp = nothing

Case Etc.
statement Etc.

End Select

Thanks,
Sevn:D
 

chergh

blah
Local time
Today, 15:39
Joined
Jun 15, 2004
Messages
1,414
Yeah that looks about right, post back with any issues you have.
 

Sevn

I trust ME!
Local time
Today, 10:39
Joined
Mar 13, 2008
Messages
97
Hello,

I have written out the following code, and it doesn't seem to be firing when I click the cmdButton. Please let me know if you see something wrong that I must be missing.

*************************
Option Compare Database
Public Sub cmdExport_Click()

Dim xlapp As excel.Application
Dim wb As excel.workbook
Dim ws As excel.worksheet
Dim rs As Recordset

Select Case [Forms]![Frm-SelectCompanyVolCat]![Combo78]

Case "1A"
Set xlapp = New excel.Application
Set wb = xlapp.workbooks.Open("C:\Documents and Settings\youngje\Desktop\Project0020-CustomerPricingMatrix\TEMPLATE-CPMByCompany.xltm")
Set ws = wb.worksheets("1A")
Set rs = CurrentDb.OpenRecordset("ExportQry-CPMByCompany")
ws.range("A2").copyfromrecordset rs

Case "1B"
Set xlapp = New excel.Application
Set wb = xlapp.workbooks.Open("C:\Documents and Settings\youngje\Desktop\Project0020-CustomerPricingMatrix\TEMPLATE-CPMByCompany.xltm")
Set ws = wb.worksheets("1B")
Set rs = CurrentDb.OpenRecordset("ExportQry-CPMByCompany")
ws.range("A2").copyfromrecordset rs

Case "1C"
Set xlapp = New excel.Application
Set wb = xlapp.workbooks.Open("C:\Documents and Settings\youngje\Desktop\Project0020-CustomerPricingMatrix\TEMPLATE-CPMByCompany.xltm")
Set ws = wb.worksheets("1C")
Set rs = CurrentDb.OpenRecordset("ExportQry-CPMByCompany")
ws.range("A2").copyfromrecordset rs

Case "1D"
Set xlapp = New excel.Application
Set wb = xlapp.workbooks.Open("C:\Documents and Settings\youngje\Desktop\Project0020-CustomerPricingMatrix\TEMPLATE-CPMByCompany.xltm")
Set ws = wb.worksheets("1D")
Set rs = CurrentDb.OpenRecordset("ExportQry-CPMByCompany")
ws.range("A2").copyfromrecordset rs

Case "2A"
Set xlapp = New excel.Application
Set wb = xlapp.workbooks.Open("C:\Documents and Settings\youngje\Desktop\Project0020-CustomerPricingMatrix\TEMPLATE-CPMByCompany.xltm")
Set ws = wb.worksheets("2A")
Set rs = CurrentDb.OpenRecordset("ExportQry-CPMByCompany")
ws.range("A2").copyfromrecordset rs

Case "2B"
Set xlapp = New excel.Application
Set wb = xlapp.workbooks.Open("C:\Documents and Settings\youngje\Desktop\Project0020-CustomerPricingMatrix\TEMPLATE-CPMByCompany.xltm")
Set ws = wb.worksheets("2B")
Set rs = CurrentDb.OpenRecordset("ExportQry-CPMByCompany")
ws.range("A2").copyfromrecordset rs

Case "2C"
Set xlapp = New excel.Application
Set wb = xlapp.workbooks.Open("C:\Documents and Settings\youngje\Desktop\Project0020-CustomerPricingMatrix\TEMPLATE-CPMByCompany.xltm")
Set ws = wb.worksheets("2C")
Set rs = CurrentDb.OpenRecordset("ExportQry-CPMByCompany")
ws.range("A2").copyfromrecordset rs

Case "2D"
Set xlapp = New excel.Application
Set wb = xlapp.workbooks.Open("C:\Documents and Settings\youngje\Desktop\Project0020-CustomerPricingMatrix\TEMPLATE-CPMByCompany.xltm")
Set ws = wb.worksheets("2D")
Set rs = CurrentDb.OpenRecordset("ExportQry-CPMByCompany")
ws.range("A2").copyfromrecordset rs

End Select

xlapp.Dialogs(xlDialogSaveAs).Show

Set rs = Nothing
Set ws = Nothing
Set wb = Nothing
Set xlapp = Nothing
End Sub
*************************

Also; for my "ALL" option, I will need to export the query 8 different times. One for each VolCat. Is there a way to modify the export portion of the code to do this. I have written out what I have in my head, but am sure it is NOT the correct code.

Case "ALL"
Set xlapp = New excel.Application
Set wb = xlapp.workbooks.Open("C:\Documents and Settings\youngje\Desktop\Project0020-CustomerPricingMatrix\TEMPLATE-CPMByCompany.xltm")
Set ws = wb.worksheets("1A")
Set rs = CurrentDb.OpenRecordset("ExportQry-CPMByCompany")
ws.range("A2").copyfromrecordset rs WHERE VolCat="1A"

Set ws = wb.worksheets("1B")
Set rs = CurrentDb.OpenRecordset("ExportQry-CPMByCompany")
ws.range("A2").copyfromrecordset rs WHERE VolCat="1B"

Set ws = wb.worksheets("1C")
Set rs = CurrentDb.OpenRecordset("ExportQry-CPMByCompany")
ws.range("A2").copyfromrecordset rs WHERE VolCat="1C"

Etc.
 

chergh

blah
Local time
Today, 15:39
Joined
Jun 15, 2004
Messages
1,414
Try adding

Code:
xlapp.visible = true

I'm guessing the code is firing but the application is remaining hidden.

As for your second question you need to get rid of the 'where' statements you have in red. I'm guessing you have a parameter in your query that gets it's value from a control on your form.

I would probably put the query into your vba

Code:
dim strSQL as string
dim strVolCat as string

strSQL = "SELECT stuff FROM table Where VolCat = '" & strVolCat & "'"

Case "ALL"
Set xlapp = New excel.Application
Set wb = xlapp.workbooks.Open("C:\Documents and Settings\youngje\Desktop\Project0020-CustomerPricingMatrix\TEMPLATE-CPMByCompany.xltm")
Set ws = wb.worksheets("1A")
strVolCat = "1A"
Set rs = CurrentDb.OpenRecordset(strSQL)
ws.range("A2").copyfromrecordset rs 

Set ws = wb.worksheets("1B")
strVolCat = "1B"
Set rs = CurrentDb.OpenRecordset(strSQL)
ws.range("A2").copyfromrecordset rs 

Set ws = wb.worksheets("1C")
strVolCat = "1C"
Set rs = CurrentDb.OpenRecordset(strSQL)
ws.range("A2").copyfromrecordset rs
 

Sevn

I trust ME!
Local time
Today, 10:39
Joined
Mar 13, 2008
Messages
97
Hello again,

I have taken a look at your suggestions, but need some clarification about something.

What goes in place of the red text. I am sure that "table" is to be ("ExportQry-CPMByCompany") with () & "" included, but am unsure what to place in "stuff".

strSQL = "SELECT stuff FROM table Where VolCat = '" & strVolCat & "'"

Case "ALL"
Set xlapp = New excel.Application
Set wb = xlapp.workbooks.Open("C:\Documents and Settings\youngje\Desktop\Project0020-CustomerPricingMatrix\TEMPLATE-CPMByCompany.xltm")
Set ws = wb.worksheets("1A")
strVolCat = "1A"
Set rs = CurrentDb.OpenRecordset(strSQL)
ws.range("1A").copyfromrecordset rs

Again; I appreciate all of your help very much.
 

chergh

blah
Local time
Today, 15:39
Joined
Jun 15, 2004
Messages
1,414
Open your query ExportQry-CPMByCompany in design view and then view the sql text and copy that text except for the where statement in it.
 

Sevn

I trust ME!
Local time
Today, 10:39
Joined
Mar 13, 2008
Messages
97
Hello again,

I have mode all of the modifications, but it still doesn't seem to be firing. I have pasted the code below. Can you take a look, and see if everything appears to be in order.

Private Sub cmdExport_Click() *I have tried Private & Public, does it matter?

Dim xlapp As Excel.Application
Dim wb As Excel.workbook
Dim ws As Excel.worksheet
Dim rs As Recordset
Dim strSQL As String
Dim strVolCat As String

strSQL = "SELECT [5) DefineCPMVolCatByCustomer].ParentTieID, [5) DefineCPMVolCatByCustomer].Customer, [5) DefineCPMVolCatByCustomer].Volume, [5) DefineCPMVolCatByCustomer].GrossPerTon, [5) DefineCPMVolCatByCustomer].GrossSales, [5) DefineCPMVolCatByCustomer].GTNPerTon, [5) DefineCPMVolCatByCustomer].GTNSales, [5) DefineCPMVolCatByCustomer].PricePerTon, [5) DefineCPMVolCatByCustomer].NetSales, [5) DefineCPMVolCatByCustomer].COGSPerTon, [5) DefineCPMVolCatByCustomer].COGS, [5) DefineCPMVolCatByCustomer].MarginSales, [5) DefineCPMVolCatByCustomer].MarginPerTon, [5) DefineCPMVolCatByCustomer].MarginPct FROM [5) DefineCPMVolCatByCustomer] Where VolCat = '" & strVolCat & "'"

Select Case [Forms]![Frm-SelectCompanyVolCat]![Combo78]

Case "1A"
Set xlapp = New Excel.Application
Set wb = xlapp.workbooks.Open("C:\Documents and Settings\youngje\Desktop\Project0020-CustomerPricingMatrix\TEMPLATE-CPMByCompany.xltm")
Set ws = wb.worksheets("1A")
strVolCat = "1A"
Set rs = CurrentDb.OpenRecordset(strSQL)
ws.range("A2").copyfromrecordset rs
xlapp.Visible = True
xlapp.Dialogs(xlDialogSaveAs).Show

End Select

Set rs = Nothing
Set ws = Nothing
Set wb = Nothing
Set xlapp = Nothing

End Sub
 

Sevn

I trust ME!
Local time
Today, 10:39
Joined
Mar 13, 2008
Messages
97
Hello again,

Well I figured out why the button wasn't firing...I had my case statement set to the wrong combo box. LOL!

Although; I get the following error when ran:
Run-time error '3061':
Too few parameters. Expected 1.

When I Debug, the editor highlights the red code below.

Code:
Option Compare Database
Private Sub cmdExport_Click()

Dim xlapp As Excel.Application
Dim wb As Excel.workbook
Dim ws As Excel.worksheet
Dim rs As Recordset
Dim strSQL As String
Dim strVolCat As String

strSQL = "SELECT [5) DefineCPMVolCatByCustomer].ParentTieID, [5) DefineCPMVolCatByCustomer].Customer, [5) DefineCPMVolCatByCustomer].Volume, [5) DefineCPMVolCatByCustomer].GrossPerTon, [5) DefineCPMVolCatByCustomer].GrossSales, [5) DefineCPMVolCatByCustomer].GTNPerTon, [5) DefineCPMVolCatByCustomer].GTNSales, [5) DefineCPMVolCatByCustomer].PricePerTon, [5) DefineCPMVolCatByCustomer].NetSales, [5) DefineCPMVolCatByCustomer].COGSPerTon, [5) DefineCPMVolCatByCustomer].COGS, [5) DefineCPMVolCatByCustomer].MarginSales, [5) DefineCPMVolCatByCustomer].MarginPerTon, [5) DefineCPMVolCatByCustomer].MarginPct FROM [5) DefineCPMVolCatByCustomer] Where VolCat = '" & strVolCat & "'"

Select Case [Forms]![Frm-SelectCompanyVolCat]![Combo94]

Case "1A"
    Set xlapp = New Excel.Application
    Set wb = xlapp.workbooks.Open("C:\Documents and Settings\youngje\Desktop\Project0020-CustomerPricingMatrix\TEMPLATE-CPMByCompany.xltm")
    Set ws = wb.worksheets("1A")
    strVolCat = "1A"
    [COLOR="Red"]Set rs = CurrentDb.OpenRecordset(strSQL)[/COLOR]
    ws.range("A2").copyfromrecordset rs
    xlapp.Visible = True
    xlapp.Dialogs(xlDialogSaveAs).Show

End Select

Set rs = Nothing
Set ws = Nothing
Set wb = Nothing
Set xlapp = Nothing

End Sub
 

MRdNk

Registered User.
Local time
Today, 15:39
Joined
Sep 27, 2008
Messages
16
Try "Dim rs As DAO.Recordset" instead of "Dim rs As Recordset"
 

Sevn

I trust ME!
Local time
Today, 10:39
Joined
Mar 13, 2008
Messages
97
Hello,

Thanks for your input, but I'm still getting the same result/error.:confused:
I'm still a newby with VBA, so I can use all the help I can get.
 

boblarson

Smeghead
Local time
Today, 08:39
Joined
Jan 12, 2001
Messages
32,059
Hello,

Thanks for your input, but I'm still getting the same result/error.:confused:
I'm still a newby with VBA, so I can use all the help I can get.
Well, for one, you have a whole bunch of bad bracketing:

Code:
"SELECT DefineCPMVolCatByCustomer.ParentTieID,
DefineCPMVolCatByCustomer.Customer,
DefineCPMVolCatByCustomer.Volume, 
DefineCPMVolCatByCustomer.GrossPerTon, 
DefineCPMVolCatByCustomer.GrossSales, 
DefineCPMVolCatByCustomer.GTNPerTon, 
DefineCPMVolCatByCustomer.GTNSales, 
DefineCPMVolCatByCustomer.PricePerTon, 
DefineCPMVolCatByCustomer.NetSales,  
DefineCPMVolCatByCustomer.COGSPerTon, 
DefineCPMVolCatByCustomer.COGS,  
DefineCPMVolCatByCustomer.MarginSales,  
DefineCPMVolCatByCustomer.MarginPerTon, 
DefineCPMVolCatByCustomer.MarginPct FROM 
DefineCPMVolCatByCustomer Where VolCat ='" & strVolCat & "'"
And if VolCat is a number it would be
Code:
"SELECT DefineCPMVolCatByCustomer.ParentTieID,
DefineCPMVolCatByCustomer.Customer,  
DefineCPMVolCatByCustomer.Volume, 
DefineCPMVolCatByCustomer.GrossPerTon, 
DefineCPMVolCatByCustomer.GrossSales, 
DefineCPMVolCatByCustomer.GTNPerTon, 
DefineCPMVolCatByCustomer.GTNSales, 
DefineCPMVolCatByCustomer.PricePerTon, 
DefineCPMVolCatByCustomer.NetSales,  
DefineCPMVolCatByCustomer.COGSPerTon, 
DefineCPMVolCatByCustomer.COGS,  
DefineCPMVolCatByCustomer.MarginSales,  
DefineCPMVolCatByCustomer.MarginPerTon, 
DefineCPMVolCatByCustomer.MarginPct FROM 
DefineCPMVolCatByCustomer Where VolCat =" & strVolCat
 

MRdNk

Registered User.
Local time
Today, 15:39
Joined
Sep 27, 2008
Messages
16
I would actually end it

& ");"

Code:
"SELECT DefineCPMVolCatByCustomer.ParentTieID,
DefineCPMVolCatByCustomer.Customer,  
DefineCPMVolCatByCustomer.Volume, 
DefineCPMVolCatByCustomer.GrossPerTon, 
DefineCPMVolCatByCustomer.GrossSales, 
DefineCPMVolCatByCustomer.GTNPerTon, 
DefineCPMVolCatByCustomer.GTNSales, 
DefineCPMVolCatByCustomer.PricePerTon, 
DefineCPMVolCatByCustomer.NetSales,  
DefineCPMVolCatByCustomer.COGSPerTon, 
DefineCPMVolCatByCustomer.COGS,  
DefineCPMVolCatByCustomer.MarginSales,  
DefineCPMVolCatByCustomer.MarginPerTon, 
DefineCPMVolCatByCustomer.MarginPct FROM 
DefineCPMVolCatByCustomer Where VolCat =" & strVolCat & ");"
 

MRdNk

Registered User.
Local time
Today, 15:39
Joined
Sep 27, 2008
Messages
16
No need to do so in Access. And MrdNk where's the left paren ( then? There isn't one.

Good point, I would always write the Where criteria inside parenthesis so:

Code:
"... WHERE ([VolCat] = " & sVolCat & ");"

Although I guess I stand corrected. Useful information for the future.
 

Sevn

I trust ME!
Local time
Today, 10:39
Joined
Mar 13, 2008
Messages
97
Hello,

Thank you for you response, but I am still getting the same error.

Here is what I have now, post corrections:

Code:
Option Compare Database
Private Sub cmdExport_Click()

Dim xlapp As Excel.Application
Dim wb As Excel.workbook
Dim ws As Excel.worksheet
Dim rs As Recordset
Dim strSQL As String
Dim strVolCat As String

strSQL = "SELECT DefineCPMVolCatByCustomer.ParentTieID, DefineCPMVolCatByCustomer.Customer, DefineCPMVolCatByCustomer.Volume, DefineCPMVolCatByCustomer.GrossPerTon, DefineCPMVolCatByCustomer.GrossSales, DefineCPMVolCatByCustomer.GTNPerTon,  DefineCPMVolCatByCustomer.GTNSales, DefineCPMVolCatByCustomer.PricePerTon, DefineCPMVolCatByCustomer.NetSales, DefineCPMVolCatByCustomer.COGSPerTon, DefineCPMVolCatByCustomer.COGS, DefineCPMVolCatByCustomer.MarginSales, DefineCPMVolCatByCustomer.MarginPerTon, DefineCPMVolCatByCustomer.MarginPct FROM DefineCPMVolCatByCustomer Where VolCat = '" & strVolCat & "'"

Select Case [Forms]![Frm-SelectCompanyVolCat]![Combo94]

Case "1A"
    Set xlapp = New Excel.Application
    Set wb = xlapp.workbooks.Open("C:\Documents and Settings\youngje\Desktop\Project0020-CustomerPricingMatrix\TEMPLATE-CPMByCompany.xltm")
    Set ws = wb.worksheets("1A")
    strVolCat = "1A"
    Set rs = CurrentDb.OpenRecordset(strSQL)
    ws.range("A2").copyfromrecordset rs
    xlapp.Visible = True
    xlapp.Dialogs(xlDialogSaveAs).Show

End Select

Set rs = Nothing
Set ws = Nothing
Set wb = Nothing
Set xlapp = Nothing

End Sub
 

MRdNk

Registered User.
Local time
Today, 15:39
Joined
Sep 27, 2008
Messages
16
If you add a breakpoint on "Select Case [Forms]![Frm-SelectCompanyVolCat]![Combo94]"
What do the values for strVolCat & strSQL show up as & are they correct?
 

Users who are viewing this thread

Top Bottom