We help IT Professionals succeed at work.

We've partnered with Certified Experts, Carl Webster and Richard Faulkner, to bring you two Citrix podcasts. Learn about 2020 trends and get answers to your biggest Citrix questions!Listen Now

x

Macro Export to Excel

Medium Priority
1,191 Views
Last Modified: 2013-11-27
Hoping this will be a quick and easy solution.
I have designed a Query in Access that has user defined parameters on a select field when ran. This field is a currency amount. So when I run the query I am only interested in a certain range.

Example: Run query, enter 0 for lower constraint, 10 for upper constraint. It gives me all records. Then I need to export this query to a Excel Workbook as a new sheet.

I want to repeat this operation say 30 times. As you can imagine doing this will get tiresome.

I started developing a macro to do this for me, but I'm stuck.

I read that you cant pass parameters to this, so I might have to create a SQL object and run the query instead. I was then going to have a loop run this mult times and just have it incr thru the loop to change the paramaters. But I cant figure out how to stop it from making new excel workbooks, and just add a new worksheet to an existing workbook.


Sub test()
Dim ParamArr As Integer
    'ParamArr = Array(0, 50, 100, 125, 150, 175, 200, 300, 400, 500)
    
    'Dim SqlStr As String
 
'SqlStr = "SELECT Db1.OP_ID AS ID, [list].PIN, Db1.AMT AS [$Val], [list].LN AS [Last Name], [list].FN AS [First Name], [list].geo AS Loc FROM [list] INNER JOIN Db1 ON [list].wild = Db1.OPERATOR_ID GROUP BY Db1.OP_ID, [list].PIN, Db1.AMT, [list].LN, [list].FN, [list].geo HAVING (((Db1.OP_ID) Is Not Null) And ((Db1.AMT) > ['lower limit'] And (Db1.AMT) <= ['upper limit'])) ORDER BY [list].geo;""
    DoCmd.RunSQL SQL_Text, False
    
 
DoCmd.SetWarnings False
 
 
'For i = 1 To ParamArr.Count
    'Want to pass i and i+1 each time, untill the end it will be 500 and the second param will be empty as i want 500+
    'Also instead of overwriting the xls file each time append new query as a new worksheet
 
' This works just exports and I still have to manually enter it.    
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "MyQuery", "C:test.xls", True
'Next
DoCmd.SetWarnings True
 
End Sub

Open in new window

Comment
Watch Question

CERTIFIED EXPERT
Top Expert 2010

Commented:
Something like this should work...

Sub test()

' code requires reference to Microsoft DAO library

    Dim xlApp As Object
    Dim xlWb As Object
    Dim xlWs As Object
    Dim xlWsInWb As Long
    Dim Arr As Variant
    Dim Counter As Long
    Dim SqlStr As String
    Dim UseSqlStr As String
    Dim rs As DAO.Recordset
    Dim ColumnCount As Long

    Arr = Array(0, 50, 100, 125, 150, 175, 200, 300, 400, 500)
    Set xlApp = CreateObject("Excel.Application")
    xlWsInWb = xlApp.SheetsInNewWorkbook
    xlApp.SheetsInNewWorkbook = UBound(Arr) + 1
    Set xlWb = xlApp.Workbooks.Add
    xlApp.SheetsInNewWorkbook = xlWsInWb

    SqlStr = "SELECT d.OP_ID AS ID, l.PIN, d.AMT AS [$Val], l.LN AS [Last Name], l.FN AS [First Name], " & _
        "l.geo AS Loc " & _
        "FROM [list] l INNER JOIN Db1 d ON l.wild = d.OPERATOR_ID " & _
        "GROUP BY d.OP_ID, l.PIN, d.AMT, l.LN, l.FN, l.geo " & _
        "HAVING d.OP_ID Is Not Null And d.AMT > ['lower limit'] And d.AMT <= ['upper limit'] " & _
        "ORDER BY l.geo"

    For Counter = 0 To UBound(Arr)
        UseSqlStr = Replace(SqlStr, "['lower limit']", Arr(Counter))
        If Counter < UBound(Arr) Then
            UseSqlStr = Replace(SqlStr, "['upper limit']", Arr(Counter + 1))
        Else
            UseSqlStr = Replace(SqlStr, "['upper limit']", 2000000000)
        End If
        Set rs = CurrentDB.OpenRecordset(UseSqlStr)
        Set xlWs = xlWb.Worksheets(Counter + 1)
        With xlWs
            For ColumnCount = 1 To rs.Fields.Count
                .Cells(1,ColumnCount) = rs.Fields(ColumnCount - 1).Name
            Next
            .Cells(2, 1).CopyFromRecordset rs
            If Counter < UBound(Arr) Then
                .Name = Arr(Counter) & " - " & Arr(Counter + 1)
            Else
                .Name = Arr(Counter) & " + "
            End If
        End With
        rs.Close
    Next

    xlApp.Visible = True
    Set xlWs = Nothing
    Set xlWb = Nothing
    Set xlApp = Nothing

End Sub

Author

Commented:
Thanks, I am getting an error when running the code tho:
Run-time error '3061':

Too few parameters. Expected 1.

and its on this line: Set rs = CurrentDb.OpenRecordset(UseSqlStr)

Any ideas? I checked all the parameters for it and it seems only the first one is required

Im using excel 2003 fyi if that makes a difference.

Thanks
CERTIFIED EXPERT
Top Expert 2010

Commented:
Afterlife,

Does your VB Project include a reference to the DAO library (and I do mean DAO and not ADO)?

Regards,

Patrick

Author

Commented:
Okay so I checked the references and Microsoft DAO 3.6 Object Library is checked.

What could the error be? It doesnt seem to like the
Set rs = CurrentDb.OpenRecordset(UseSqlStr)
line at all.
CERTIFIED EXPERT
Top Expert 2010

Commented:
Afterlife,

It would be useful to see some sample data and/or a sample file.  EE now allows you
to directly upload files to your question.

Please be advised that once you upload a file, it can be publicly accessed, and that it
may not be possible to fully and permanently delete it.  Therefore, be very careful about
posting proprietary, confidential, or other sensitive information.  If necessary, use "fake"
and/or obfuscated data in your sample.

Please note that at present EE restricts uploads to certain file types.  If your file type
does not match those in the list, you can use www.ee-stuff.com instead, which is not
officially an EE site, but is run by people connected to EE.

Regards,

Patrick

Author

Commented:
Thanks for your help thus far Matthewspatrick.

Okay I cant upload the files as they are 90MB+

What I did was simplify the SqlStr and the table. I can work out the more complicated SqlStr later.

Sample Table Data Now looks like this:
Key      UID      CODE      AMT
1      1111111      Test1      5
2      1111112      Test2      10
3      1111111      Test1      5
4      1111116      Test1      10
5      1111115      Test3      25

The Code is below Im attempting to run. Excel 2003.

I hope this helps.


Sub test2()
 
' code requires reference to Microsoft DAO library
 
    Dim xlApp As Object
    Dim xlWb As Object
    Dim xlWs As Object
    Dim xlWsInWb As Long
    Dim Arr As Variant
    Dim Counter As Long
    Dim SqlStr As String
    Dim UseSqlStr As String
    Dim rs As DAO.Recordset
    Dim ColumnCount As Long
 
    Arr = Array(0, 50, 100, 125, 150, 175, 200, 300, 400, 500)
    Set xlApp = CreateObject("Excel.Application")
    xlWsInWb = xlApp.SheetsInNewWorkbook
    xlApp.SheetsInNewWorkbook = UBound(Arr) + 1
    Set xlWb = xlApp.Workbooks.Add
    xlApp.SheetsInNewWorkbook = xlWsInWb
        
    SqlStr = "SELECT MyTable.UID AS ID, MyTable.AMT AS AMT " & _
        "FROM MyTable " & _
        "GROUP BY MyTable.UID, MyTable.AMT " & _
        "HAVING (((MyTable.UID) Is Not Null) AND ((MyTable.Amt)>[lower limit] And (MyTable.AMT)<=[upper limit]));"
        
 
 
    For Counter = 0 To UBound(Arr)
        UseSqlStr = Replace(SqlStr, "[lower limit]", Arr(Counter))
        If Counter < UBound(Arr) Then
            UseSqlStr = Replace(SqlStr, "[upper limit]", Arr(Counter + 1))
        Else
            UseSqlStr = Replace(SqlStr, "[upper limit]", 2000000000)
        End If
        Set rs = CurrentDb.OpenRecordset(UseSqlStr)
        Set xlWs = xlWb.Worksheets(Counter + 1)
        With xlWs
            For ColumnCount = 1 To rs.Fields.Count
                .Cells(1, ColumnCount) = rs.Fields(ColumnCount - 1).Name
            Next
            .Cells(2, 1).CopyFromRecordset rs
            If Counter < UBound(Arr) Then
                .Name = Arr(Counter) & " - " & Arr(Counter + 1)
            Else
                .Name = Arr(Counter) & " + "
            End If
        End With
        rs.Close
    Next
 
    xlApp.Visible = True
    Set xlWs = Nothing
    Set xlWb = Nothing
    Set xlApp = Nothing
 
End Sub

Open in new window

CERTIFIED EXPERT
Top Expert 2010

Commented:
Afterlife,

My apologies--I had an error in one portion of the code :)

Replace:

        If Counter < UBound(Arr) Then
            UseSqlStr = Replace(SqlStr, "['upper limit']", Arr(Counter + 1))
        Else
            UseSqlStr = Replace(SqlStr, "['upper limit']", 2000000000)
        End If

with:

        If Counter < UBound(Arr) Then
            UseSqlStr = Replace(UseSqlStr, "['upper limit']", Arr(Counter + 1))
        Else
            UseSqlStr = Replace(UseSqlStr, "['upper limit']", 2000000000)
        End If

Regards,

Patrick

Author

Commented:
Okay its doing what i wanted it to, just a few minor things.

For some reason its not incrementing the array after the first iteration. I get all the sheets I wanted but all have the exact same data, the array isnt advancing at the end of the loop.

Im going to trace it myself, if u know why tho let me know.
CERTIFIED EXPERT
Top Expert 2010
Commented:
Afterlife,

Not sure what the problem could be. It works splendidly in my test db.

Regards,

Patrick
db1.mdb

Not the solution you were looking for? Getting a personalized solution is easy.

Ask the Experts

Author

Commented:
Thanks MatthewsPatrick.

The problem was at the end of the loop UseSqlStr was never reset to the original so the second check for replace ['lower limit'] never happens as it was replaces the first time, so i just reset it at the end.

Thanks, works like a charm!

If you could add in how to prefeine the workbook name and just have it do it not create a nameless one and make it pop up at the end. Thanks!
Access more of Experts Exchange with a free account
Thanks for using Experts Exchange.

Create a free account to continue.

Limited access with a free account allows you to:

  • View three pieces of content (articles, solutions, posts, and videos)
  • Ask the experts questions (counted toward content limit)
  • Customize your dashboard and profile

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.