asked on

Macro Export to Excel

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

Patrick Matthews

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

Afterlife

ASKER

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

Patrick Matthews

Afterlife,

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

Regards,

Patrick

Afterlife

ASKER

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.

Patrick Matthews

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

Afterlife

ASKER

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

Patrick Matthews

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

Afterlife

ASKER

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.

ASKER CERTIFIED SOLUTION

Patrick Matthews

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Afterlife

ASKER

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!