Need some help with code exporting queries to specific excel sheets?

BigMike

Registered User.
Local time
Today, 07:01
Joined
May 30, 2013
Messages
23
Export multiple queries to multiple excel sheets.

Code:
Option Compare Database
Private Sub Command11_Click()
' ______________________________________________________________________
' EXPORTS "BLOCK COUNT (FILTERED)" QUERY TO EXCEL SHEET1
Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim strPath As String
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    On Error GoTo err_handler
 
 
    strPath = strFilePath
 
 
    Set rst = CurrentDb.OpenRecordset("Block Count (Filtered)")
 
    Set ApXL = CreateObject("Excel.Application")
 
 
    Set xlWBk = ApXL.Workbooks.Open("C:\FileName")
 
    ApXL.Visible = True
 
    Set xlWSh = xlWBk.Worksheets("Sheet1")
    xlWSh.Activate
 
    xlWSh.Range("A1").Select
 
    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next
 
    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
 
    xlWSh.Range("1:30").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
 
    ApXL.Selection.Font.Bold = False
 
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
 
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
 
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
 
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
 
    rst.Close
 
    Set rst = Nothing
 
Exit_SendTQ2XLWbSheet:
    Exit Sub
 
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendTQ2XLWbSheet
Exit Sub
End Sub
Private Sub Command12_Click()
' ____________________________________________________________________
' EXPORTS "PROPOSAL COUNT (FILTERED)" TO EXCEL SHEET2
Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim strPath As String
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    On Error GoTo err_handler
 
 
    strPath = strFilePath
 
 
    Set rst = CurrentDb.OpenRecordset("Proposal Count (Filtered)")
 
    Set ApXL = CreateObject("Excel.Application")
 
 
    Set xlWBk = ApXL.Workbooks.Open("C:\FileName")
 
    ApXL.Visible = True
 
    Set xlWSh = xlWBk.Worksheets("Sheet2")
    xlWSh.Activate
 
    xlWSh.Range("A1").Select
 
    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next
 
    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
 
    xlWSh.Range("1:30").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
 
    ApXL.Selection.Font.Bold = False
 
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
 
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
 
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
 
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
 
    rst.Close
 
    Set rst = Nothing
 
Exit_SendTQ2XLWbSheet:
    Exit Sub
 
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendTQ2XLWbSheet
Exit Sub
End Sub
Private Sub Command13_Click()
' __________________________________________________________________________
' EXPORTS "BLOCK SENDBACKS (FILTERED)" TO EXCEL SHEET3
Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim strPath As String
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    On Error GoTo err_handler
 
 
    strPath = strFilePath
 
 
    Set rst = CurrentDb.OpenRecordset("Block Sendbacks (Filtered)")
 
    Set ApXL = CreateObject("Excel.Application")
 
 
    Set xlWBk = ApXL.Workbooks.Open("C:\FileName")
 
    ApXL.Visible = True
 
    Set xlWSh = xlWBk.Worksheets("Sheet3")
    xlWSh.Activate
 
    xlWSh.Range("A1").Select
 
    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next
 
    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
 
    xlWSh.Range("1:30").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
 
    ApXL.Selection.Font.Bold = False
 
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
 
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
 
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
 
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
 
    rst.Close
 
    Set rst = Nothing
 
Exit_SendTQ2XLWbSheet:
    Exit Sub
 
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendTQ2XLWbSheet
Exit Sub
End Sub
Private Sub Command14_Click()
' ______________________________________________________________________
' EXPORTS "PROPOSAL SENDBACKS (FILTERED)" TO EXCEL SHEET4
Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim strPath As String
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    On Error GoTo err_handler
 
 
    strPath = strFilePath
 
 
    Set rst = CurrentDb.OpenRecordset("Proposal Sendbacks (Filtered)")
 
    Set ApXL = CreateObject("Excel.Application")
 
 
    Set xlWBk = ApXL.Workbooks.Open("C:\FileName")
 
    ApXL.Visible = True
 
    Set xlWSh = xlWBk.Worksheets("Sheet4")
    xlWSh.Activate
 
    xlWSh.Range("A1").Select
 
    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next
 
    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
 
    xlWSh.Range("1:30").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
 
    ApXL.Selection.Font.Bold = False
 
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
 
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
 
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
 
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
 
    rst.Close
 
    Set rst = Nothing
 
Exit_SendTQ2XLWbSheet:
    Exit Sub
 
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendTQ2XLWbSheet
Exit Sub
End Sub

That is my code. Sorry it is so long, but it is the same code four times on four different command buttons for four different queries that I am exporting from access to excel.

Once I export the first query, my code opens up the correct excel workbook and places it on the correct spreadsheet (Sheet1). This workbook stays open, so when I export the second query it opens up a [Read-Only] version of the correct workbook and places it on the correct sheet (Sheet2), but it is on a copy of the correct workboook.

So now I have two of the same workbooks open with one export in each. I export the third query and a third read-only workbook opens. I export a fourth query and a fourth read-only workbook opens. Even though the exports are on the correct sheets in the copies of the workbooks, they are all in separate workbooks.

If after each individual export, I save and the close the excel workbook before the next export, everything works as planned, but I would rather not do that considering I have several more queries that I will be creating and exporting.

How do I fix my code so after the first export, I can keep the excel workbook open and keep exporting each query into the appropriate sheet?

I am very sorry this is so long, but I wanted to try and explain this the best way I could.

Thank you for any help that you can provide!
 
Last edited:
Well firstly replace the 4 subs with just 1 and call that sub from your command button clicks, supplying the different information; it will save you space.

Secondly, if the 4 exports are going to happen 1,2,3,4 straight off the bat, set a global variable to represent the open worksheet. So when you first open it, the global variable now represents it, so the additional exports can be sent to an already open worksheet.

Have a look at Bob Larsons site for some good examples, like http://www.btabdevelopment.com/ts/tq2xlspecwspath
 
Would you mind typing that out for me?

The code I mentioned in the question is copy and pasted from that exact site, because I don't really know what I am doing with VBA. So I tried using his code four separate times and that is where I am at now.
 
Can I please get some help? I am not good with VBA.
 
See attached. Just copy the module into your database, then call the sub (supplying the needed data). The sub can work with a supplied workbook path or can add a new book. If you use a new book bare in mind it will only have a set number of sheets (4) so you could only save 4 queries/tables.

Have a look and shout if you need anything.
 

Attachments

I took your code, put it under a command button, and tried plugging in my information. Simply put, I'm sure I didn't do something right, so try to be patient with me. I get the error "Compile Error: Invalid attribute in Sub or Function" and it highlights the word "Public" on the second line. What do I need to fix?

Code:
Private Sub Command15_Click()
Public ApXl As Object 'Represents the Excel objext
Public xlWBk As Object 'represents the workbook
Public blnWkBkOpn  As Boolean 'indicates if the workbook has already been opened - for use when saving multiple queries
Option Compare Database
Public Sub ExportQueries(strRecordSource As String, strSheet As String, blnLastQuery As Boolean, Optional strWkBookPath As String)
'strRecordSource Name of Record source (table or Query) to export
'strSheet Name of worksheet to export to
'blnLastQuery True=last export so close workbook, False = more to export so DONT close the workbook
'strWkBookPath optional path of workbook to use. If left out of call, a new workbook will be added
' ______________________________________________________________________
    Dim rst As DAO.Recordset
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim blnNewBk As Boolean 'indicates True new workbook or False existing workbook
 
    blnNewBk = Len("C:\MyFileName") = 0
 
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    On Error GoTo err_handler
    Set rst = CurrentDb.OpenRecordset("MyQueryName") 'open recordsource for export
    If Not blnWkBkOpn Then 'check if workbook already open
        Set ApXl = CreateObject("Excel.Application") 'create Excel object
        If blnNewBk Then 'check if new workbook or supplied path
            ApXl.SheetsInNewWorkbook = 4 'sets number of sheets in new workbook to 4
            Set xlWBk = ApXl.Workbooks.Add
        Else
            Set xlWBk = ApXl.Workbooks.Open("C:\MyFileName")
        End If
 
        ApXl.Visible = True
        blnWkBkOpn = True
    End If
 
    Set xlWSh = xlWBk.Worksheets("MyWorkBookName")
    xlWSh.Activate
 
    xlWSh.Range("A1").Select
 
    For Each fld In rst.Fields
        ApXl.ActiveCell = fld.Name
        ApXl.ActiveCell.Offset(0, 1).Select
    Next
 
    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
 
    ' does the "autofit" for all columns
    ApXl.ActiveSheet.Cells.EntireColumn.AutoFit
 
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
 
    rst.Close
 
    Set rst = Nothing
    If blnLastQuery Then 'if last export save & close workbook and clear object variables
        If blnNewBk Then 'if new book get save file name
            Do
            fName = ApXl.GetSaveAsFilename
            Loop Until fName <> False
            xlWBk.SaveAs FileName:=fName
            xlWBk.Close
        Else
            xlWBk.Close True
        End If
 
        Set xlWBk = Nothing
        Set ApXl = Nothing
    End If
Exit_SendTQ2XLWbSheet:
    Exit Sub
 
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendTQ2XLWbSheet
Exit Sub
End Sub

I really appreciate your help!
 
This code needs to go in its own module, not in the code section for a control (command button). You then call the routine ExportQueries (from your command button) EG Call ExportQueries(Table/Query name, Sheet name, True or False is this the last query to export to the workbook, optionally the file path to an exisitng workbook). All the instructions on the parameters are included with the code.


So in your scenario (with 4 queries to one workbook)
Private Sub Command15_Click()
Call ExportQueries("Query1", "Sheet1", FALSE,"C:\MyFileName")
Call ExportQueries("Query2", "Sheet2",FALSE, "C:\MyFileName")
Call ExportQueries("Query3", "Sheet3",FALSE,"C:\MyFileName")
Call ExportQueries("Query4", "Sheet4", TRUE, "C:\MyFileName")
End Sub
 
Thank you for replying so quickly!

Okay, so I created a new module (Module1) and I put your code in. Then, I typed all the "Call ExportQueries" under my command button. I get an error that says: "Automation error. The object involved has disconnected from its clients." I tried a couple different things and kept getting the same error. I get the error four times(for each one of my queries).

This is my Module1:
Code:
Public ApXl As Object 'Represents the Excel objext
Public xlWBk As Object 'represents the workbook
Public blnWkBkOpn  As Boolean 'indicates if the workbook has already been opened - for use when saving multiple queries
Option Compare Database
Public Sub ExportQueries(strRecordSource As String, strSheet As String, blnLastQuery As Boolean, Optional strWkBookPath As String)
'strRecordSource Name of Record source (table or Query) to export
'strSheet Name of worksheet to export to
'blnLastQuery True=last export so close workbook, False = more to export so DONT close the workbook
'strWkBookPath optional path of workbook to use. If left out of call, a new workbook will be added
' ______________________________________________________________________
    Dim rst As DAO.Recordset
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim blnNewBk As Boolean 'indicates True new workbook or False existing workbook
 
    blnNewBk = Len("C:\MyFilePath") = 0
 
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    On Error GoTo err_handler
    Set rst = CurrentDb.OpenRecordset("Block Count (Filtered)") 'open recordsource for export
    If Not blnWkBkOpn Then 'check if workbook already open
        Set ApXl = CreateObject("Excel.Application") 'create Excel object
        If blnNewBk Then 'check if new workbook or supplied path
            ApXl.SheetsInNewWorkbook = 4 'sets number of sheets in new workbook to 4
            Set xlWBk = ApXl.Workbooks.Add
        Else
            Set xlWBk = ApXl.Workbooks.Open("C:\MyFilePath")
        End If
 
        ApXl.Visible = True
        blnWkBkOpn = True
    End If
 
    Set xlWSh = xlWBk.Worksheets("Copy of Case Count 3.xlsx")
    xlWSh.Activate
 
    xlWSh.Range("A1").Select
 
    For Each fld In rst.Fields
        ApXl.ActiveCell = fld.Name
        ApXl.ActiveCell.Offset(0, 1).Select
    Next
 
    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
 
    ' does the "autofit" for all columns
    ApXl.ActiveSheet.Cells.EntireColumn.AutoFit
 
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
 
    rst.Close
 
    Set rst = Nothing
    If blnLastQuery Then 'if last export save & close workbook and clear object variables
        If blnNewBk Then 'if new book get save file name
            Do
            fName = ApXl.GetSaveAsFilename
            Loop Until fName <> False
            xlWBk.SaveAs FileName:=fName
            xlWBk.Close
        Else
            xlWBk.Close True
        End If
 
        Set xlWBk = Nothing
        Set ApXl = Nothing
    End If
Exit_SendTQ2XLWbSheet:
    Exit Sub
 
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendTQ2XLWbSheet
Exit Sub
End Sub

In about the 9th line of code in the above Module1 it says:
Code:
Set rst = CurrentDb.OpenRecordset("Block Count (Filtered)") 'open recordsource for export

"Block Count (Filtered)" is just a name of one of my queries. Is this wrong?

Also, here is my command button:
Code:
Private Sub Command15_Click()
 Call ExportQueries("Block Count (Filtered)", "Sheet1", False, "C:\MyFilePath")
 Call ExportQueries("Proposal Count (Filtered)", "Sheet2", False, "C:\MyFilePath")
 Call ExportQueries("Block Sendbacks (Filtered)", "Sheet3", False, "C:\MyFilePath")
 Call ExportQueries("Proposal Sendbacks (Filtered)", "Sheet4", True, "C:\MyFilePath")
End Sub
 
I tried everything again with the same codes as my post above. I hit my command button and all it did was open up excel. Nothing happened to the excel workbook, it stayed the same, it just opened up.

I looked back at my access page and it says the error; "Subscript out of range" four times (once for each query I assume). So I hit my command button again to see what would happen and I got the error: "Automation error. The object involved has disconnected from its clients."
 
The idea behind having an 'all in one' routine is to save space by providing the file, sheet or query names as variables in the call to the routine. The only place that you should have file, sheet or query names is in the Command button code. All the code in ExportQueries should be variables representing the data you pass in.
So remove;
"C:\MyFilePath" and replace with strWkBookPath - this is the 4th parameter in the Call
"Block Count (Filtered)" and replace with strRecordSource - This is the first parameter in the Call
"Copy of Case Count 3.xlsx" and replace with strSheet - This is the 2nd parameter in the Call

The Automation error is because the Excel object has been closed (after the 4th query). I did not include a line to set the global variable blnWkBkOpn to false. So towards the end of my code, after;

Code:
        Set xlWBk = Nothing
        Set ApXl = Nothing

put in
Code:
        blnWkBkOpn = False

you should have:
Code:
        Set xlWBk = Nothing
        Set ApXl = Nothing
        blnWkBkOpn = False
    End If
 
Thank you very very much! This works perfectly! I really appreciate that you stuck with me and helped me out!

Your code opens up the correct excel workbook, exports the queries, overwrites it, and closes it back down. Before it saves the overwrite, can I get it to ask me to "save as" so I can save it under a different file name and keep the previous monthly records?

Also, since you explained this so well, I have another question for you. These queries that you just helped me export to excel are monthly performance numbers.

For instance, now that it is June, I need to make reports for May. The only way I know how to do this is by going into each one of my queries and manually filter them for "May 2013" (or whatever the previous month is).

Is there any way that I can get my queries to automatically filter for the previous month so all I have to do is hit my export button?
 
Last edited:
This all depends on how the dates are recorded and the formatting. Essentially you add a criteria to the queries against the field(s) containing date(s).

lets say you have a field that records the date a record is recorded. the criteria Month([DateField]) = (Month(Date)-1) would return records where the datefield contains a date 1 month prioir to this month.
 
I went into the design view of "Block Count (Filtered)" (my query) and try tossing "Month([BlockDesDateStamp]) = (Month(Date)-1)" into the "Criteria" under the field name "BlockDesDateStamp" which is the column that deals with the dates. A window pops up asking to "Enter Parameter Value" and type something for "DateField". What should I type in this window? Am I even on the right path?

The dates are recorded (mm/dd/yyyy hh:mm.ss AM or PM). When I use the query wizard, I choose my fields and it asks me "How would you like to group dates in your query?" and I select "Month". With this selected, my query lists the data (earliest data) January 2011, February 2011,...(all the way to current data) April 2013, May 2013....

So I have like thousands of results showing from the very first data that was ever entered to data entered yesterday. I click the down arrow at the field name and check the box next to whatever month I want (ex. "May 2013") which gives me the correct results for that month.

That is how I have been doing my queries. I hope this helps. If there is anything else I can post (like SQL or something) to help you, let me know.

Example of one of my queries:
Query Name: "Block Count (Filtered)"
DateField: "BlockDesDateStamp" - this is what I want to auto filter by previous month

Again, thank you so much for your help!
 
The SQL of this "Block Count (Filtered)" query would be useful.

So long as you have typed Month([BlockDesDateStamp]) = (Month(Date)-1) into the "Criteria" under the field name "BlockDesDateStamp" it should not prompt you for a parameter. The fact that it is asking you to type something for "DateField" suggests you may have my generic example Month([DateField]) = (Month(Date)-1) in there 9or at least the DateField part!).
 
Attached in the zip folder is a .docx or .pdf with the following:

First, I listed the SQL.
Second, picture of query in datasheet view.
Third, picture of query in design view.
Fourth, picture of query in design view with it asking for parameter.

Note: I created this query with the 4 field names from a table, tried filtering by form, and saved the form filter as a query, so I don't know if this could be a problem or not. So the "BlockDesigner" and "Blocks Submitted" field names also have filters on them. I don't know if that would mess things up or not.

I just gave you a bunch of things to try and make it easier for you.

What am I getting wrong? If there is a better way to create my queries so it is easier to filter, then I can do that, just let me know.

I will also post the SQL in coding below:
Code:
SELECT *
FROM [Block Count] LEFT JOIN (SELECT tblEmployees.[Emp_ID], [tblEmployees].[Designers] FROM tblEmployees ORDER BY [Designers])  AS Lookup_BlockDesigner ON [Block Count].BlockDesigner = Lookup_BlockDesigner.Emp_ID
WHERE ((([Block Count].[BlockDesDateStamp By Month])="April 2013") AND ((Lookup_BlockDesigner.Designers) Is Not Null And (Lookup_BlockDesigner.Designers)<>"") AND (([Block Count].[Blocks Submitted])=True));
 

Attachments

Ok thanks for that. The entry you have with "April 2013" will not work because you are comparing a date to a string. The prompt box comes up in the other example because the field is not available to the query so it sees it as a parameter.

The formula you will need is a little more complex than i first stated due to taking the year into account (my initial suggestion would return entries for the month from any year!). You need to compare Year and Month.
The criteria you will need to use under [BlockDesDateStamp], is:
Code:
Year([BlockDesDateStamp])*12+DatePart("m",[BlockDesDateStamp])=Year(Date())*12+DatePart("m",Date())-1

Notice i said [BlockDesDateStamp] not [BlockDesDateStamp by Month]. You could try the criteria against [BlockDesDateStamp by Month] and if it works, well good. I am not sure it will however, but against the actual date field ([BlockDesDateStamp]) it should.
 
I applied that criteria to [BlockDesDateStamp] and worked just like you said, thank you.

Is there any way that I can get it to tally the numbers for each "BlockDesigner"? I attached another document to show you what I mean. So bangel1 would only be listed once and the "Count of tbl" would say 16, instead of bangel1 listed 16 times. And bhugeuna would be listed once and the "Count of tbl" would say 14.

I don't even know if this will be possible, but do you know what I mean? Is there a way to tally each person's data into one row?

It doesn't matter what exactly is in the "BlockDesDateStamp" column, as long as it is filtered for the previous month.
 

Attachments

2 ways you could try, but you wont get the counts on one row.

First you could try a crosstab query. Use the Query Wizard and it will take you through the process. Essentially you would want BlockDesigner as Row headings, another field as column headings and any field as the value and use the count() function on it. This will return a query that has all the BlockDesigner down the left and the second column would be the count of the BlockDesigner's name.

Secondly you could create a query with just BlockDesigner. Then create a second query based on the same table, where you use the Dcount() function to count how many times the name appears.

If you have a separate table with BlockDesigner names in, then you will only need 1 query (base it on the separate table) where you use the Dcount() function to count how many times the name appears in the main table (Block Count?)
 
Thanks for the suggestions, but the layout that you helped me with before is easier to work with.

One last question (I think) on those queries that you helped me export to excel earlier. Your code opens up the excel workbook, exports the queries, overwrites it, and closes it back down. Before it saves the overwrite, can I get it to ask me to "save as" so I can save it under a different file name and keep the previous monthly records?
 
couple of ways to do this. First is in the code already if you don't supply a file path to a current workbook,

add this before xlWBk.Close True
Code:
fName = ApXl.getsaveasfilename
            Loop Until fName <> False
            xlWBk.SaveAs FileName:=fName


Second way is to use the Office.Filedialog. You will need to add all of the following;

At the start after Dim blnNewBk As Boolean
Code:
Dim objFileDialog As Office.FileDialog
Dim strSaveFile As String
Set objFileDialog = Application.FileDialog(msoFileDialogSaveAs)

then before xlWBk.Close True add
Code:
If objFileDialog.Show Then
    ' Display the full path to each file that was selected
    Dim i As Integer
    For i = 1 To objFileDialog.SelectedItems.Count
        strSaveFile = objFileDialog.SelectedItems(i)
    Next i
End If

xlWBk.SaveAs FileName:=strSaveFile
 

Users who are viewing this thread

Back
Top Bottom