Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Macro Export to Excel

Posted on 2009-02-16
10
Medium Priority
?
1,156 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

0
Comment
Question by:Afterlife
  • 5
  • 5
10 Comments
 
LVL 93

Expert Comment

by:Patrick Matthews
ID: 23650925
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
0
 

Author Comment

by:Afterlife
ID: 23651780
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
0
 
LVL 93

Expert Comment

by:Patrick Matthews
ID: 23652414
Afterlife,

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

Regards,

Patrick
0
Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

 

Author Comment

by:Afterlife
ID: 23652981
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.
0
 
LVL 93

Expert Comment

by:Patrick Matthews
ID: 23653850
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
0
 

Author Comment

by:Afterlife
ID: 23660185
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

0
 
LVL 93

Expert Comment

by:Patrick Matthews
ID: 23670179
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
0
 

Author Comment

by:Afterlife
ID: 23672593
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.
0
 
LVL 93

Accepted Solution

by:
Patrick Matthews earned 400 total points
ID: 23675940
Afterlife,

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

Regards,

Patrick
db1.mdb
0
 

Author Closing Comment

by:Afterlife
ID: 31547364
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!
0

Featured Post

Fill in the form and get your FREE NFR key NOW!

Veeam is happy to provide a FREE NFR server license to certified engineers, trainers, and bloggers.  It allows for the non‑production use of Veeam Agent for Microsoft Windows. This license is valid for five workstations and two servers.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …
This lesson discusses how to use a Mainform + Subforms in Microsoft Access to find and enter data for payments on orders. The sample data comes from a custom shop that builds and sells movable storage structures that are delivered to your property. …

810 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question