Exporting Access Query to Excel 3

[SHAWTY721]

I am trying to send the results of a query that runs when a button is clicked on a form. Originally I used teh DoCmd.TransferSpreadsheet to export the information but I was informed that by using the DoCmd.TransferSpreadsheet method you are unable to dictate which fields records should go to so I created a Public Function. I receive this error when I click the button: 'Run-time error ‘3061’:
To few parameters. Expected 4.'

This is what my function looks like:
Public Function ExportQuery() As String
On Error GoTo err_Handler

'Excel object variables
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet

Dim sTemplate As String
Dim sTempFile As String
Dim sOutput As String

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sSQL As String
Dim IRecords As Long
Dim iRow As Integer
Dim iCol As Integer
Dim iFld As Integer

Const cTabOne As Byte = 1
Const cTabTwo As Byte = 2
Const cStartRow As Byte = 3
Const cStartColumn As Byte = 1

DoCmd.Hourglass True

'Set to break on all errors
Application.SetOption "Error Trapping", 0

'Start with clean file built from template file
sTemplate = CurrentProject.Path & "\JournalEntryTest.xls"
sOutput = CurrentProject.Path & "\JournalEntryFormTest.xls"
If Dir(sOutput) <> "" Then Kill sOutput
FileCopy sTemplate, sOutput

'Create the Excel Application, Workbook and Worksheet and Database object
Set appExcel = New Excel.Application
appExcel.Visible = True
Set wbk = appExcel.Workbooks.Open(sOutput)

sSQL = "SELECT * FROM qryJEtest"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
If Not rst.BOF Then
rst.MoveFirst
'For this template, the data must be placed in the appropriate cells of the spreadsheet
Do While Not rst.EOF
With wbk
.Sheets("JournalEntry").Range("G3") = rst.Fields("Branch Number")
.Sheets("JournalEntry").Range("K15") = rst.Fields("Account")
.Sheets("JournalEntry").Range("L15") = rst.Fields("Sub Account")
.Sheets("JournalEntry").Range("O15") = rst.Fields("SUMOfGROSS")
.Sheets("JournalEntry").Range("Q15") = rst.Fields("Account Description")
.Sheets("JournalEntry").Range("G3,K15,L15,O15,Q15").Columns.AutoFit
.SaveAs CurrentProject.Path & "\" & rst.Fields("Branch Number&""&Description") & " .xls"
End With
rst.MoveNext
Loop
rst.Close

ExportQuery = "Total of " & IRecords & " rows processed."

exit_Here:
'Cleanup all objects (resume next on errors)
Set wbk = Nothing
appExcel.Quit
Set appExcel = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
Exit Function

err_Handler:
ExportQuery = Err.Description
Resume exit_Here
End If
End Function

 

[TwoOdd]

Looking at your code more closely, it looks like your are placing your values in the same line on the spreadsheet:

        .Cells(3, 7).Value = rst.Fields("BranchNumber").Value
        .Cells(15, 11).Value = rst.Fields("GL_Acct").Value
        .Cells(15, 12).Value = rst.Fields("GL_Subacct").Value
        .Cells(15, 15).Value = rst.Fields("GROSS").Value    
        .Cells(15, 17).Value = rst.Fields("AccountDescription").Value

Correct me if I'm wrong, but those look like hard coded cells instead of variable cells - so it looks like you are replacing the values of those cells with the current record which means your spreadsheet will end up only showing you the values of the last record in the recordset.

TwoOdd
--------------
Good judgment comes from experience, and experience comes from bad judgment.
-- Barry LePatner

 

[TwoOdd]

Just found an error in my sample code - was modifying it to post and deleted one too many lines in the second sub procedure. Here is the corrected sub procedure just in case someone needs to use it:

Private Sub cmd_Export(varQuery, varWorksheetName)
    Dim MySQL As String
    Dim rs As Recordset
    Dim intMaxCol As Integer
    Dim intMaxRow As Integer
    
    MySQL = varQuery
    Set rs = CurrentDb.OpenRecordset(MySQL, dbOpenSnapshot)

    intMaxCol = rs.Fields.Count
    If rs.RecordCount > 0 Then
        rs.MoveLast
        rs.MoveFirst
        intMaxRow = rs.RecordCount
        objWkb.Worksheets.Add
        objWkb.Worksheets(1).Name = varWorksheetName
        Set objSht = objWkb.Worksheets(varWorksheetName)
        With objSht
            Dim fldLoop As Field
            Dim fldCount As Integer
            fldCount = 1
	    'Create Column Headers from Field Names in row 2
            For Each fldLoop In rs.Fields
                .Cells(2, fldCount) = fldLoop.Name
                fldCount = fldCount + 1
            Next

	    'Import data starting in row 3
	    .Range(.Cells(3, 1), .Cells(3, intMaxCol)).CopyFromRecordset rs


	    'Once imported, you can now use Excel VBA to modify the spreadsheet
	    'Below are some examples
            .Range("A2").FormulaR1C1 = "Description"
            .Columns("B:G").NumberFormat = "$#,##0.00"
            .Cells.Select
            .Cells.EntireColumn.AutoFit
            .Cells(1, 1).Select

        End With
    End If
End Sub

TwoOdd
--------------
Good judgment comes from experience, and experience comes from bad judgment.
-- Barry LePatner

 

[lameid]

SHAWTY721,

There is no Gross field in your SQL...

Sum(tblAllPerPayPeriodEarnings.GROSS) becomes (most likely) SUMOFGROSS at execution time because it is not aliased. Change it to

Sum(tblAllPerPayPeriodEarnings.GROSS) AS GROSS

Italics added for emphasis.

Also, TwoOdd is right about you not incrementing your rows in Excel. In you loop you are incrementing both a row count and another variable J. Likely, you intend to increment the row based on one of these?

Instead of

.Cells(15, 11).Value = rst.Fields("GL_Acct").Value

Perhaps you mean

.Cells(J, 11).Value = rst.Fields("GL_Acct").Value

Of course you would need to intialize J to 15 beore the loop...

J = 15

Alos, TwoOdd's code looks like it is sound on cursory review so you may have better luck with it if it makes more sense to you.

 

[JerryKlmns]

SHAWTY721

Your first post was exporting one record at one spreadsheet/workbook. The next reviels that a branch could have many records. So TwoOdd & lameid are both correct about changing the cell 's row. TwoOdd's way uses the CopyFromRecordset method of the range object that does not suit for what you are trying to do

 

[SHAWTY721]

So what should I try to get all the results of the SQL statement to be sent to the excel spreadsheet.

 

[JerryKlmns]

If your goal is to create for each branch a seperate excel workbook for its accounts, I think you need a loop to gather all branches to be exporting and inside that loop open a different recordset (for its records only) and place those records at the cells you need. When advancing in the internal loop you should increment the cell 's row. When advancing at the external loop you should save the workbook with the branch (ID?) and reuse the "template" excel workobook.

 

[lameid]

SHAWTY721,

Specifically, you need to move your populating of branch number outside your do loop, and modify the contents of it to write multiple records as I described.

For a test run, run only for one branch.

After that work on calling or using the same function for all the branches... maybe pass the branch to the procedure.

I'm not clear on whether you want a sheet for each branch or a whole new file.

 

[SHAWTY721]

The query is a parameter query so the results of the query are dependent on what fields are selected from the specified form. Will this effect how I have to set up the loop to write all results of the query

 

[lameid]

Ultimately, I would take the SQL you have now, copy and modify to run for a list of branch numbers. This is used in a new procedure that loops through the branches of that recordset and runs the function you have now modified to run by a specified branch.

For you, I would start with the current procedure and get it working with populating the rows for all branches. When your code writes the branch it will either write the first or last branch depending on whether you leave it in the loop or not.

Then modify it to run for a branch.

Then write the other function to run it multiple times by branch.

 

[SHAWTY721]

I am completely confused now. So I have to re-write the code that I am currently using.

 

[lameid]

No it just needs modifications.

Just start by modifying it to write all the excel rows to the excel sheet.

 

[SHAWTY721]

How do I do that. The branch number is dependent on the selections that are made on my form because each branch number represents a specific company.

 

[lameid]

So there is already exactly one Branch for the criteria you are using?

If so just go back to my post before JerryKlmns and forget everything else.

 

[rheitzman]

Consider using Excel instead of Access to do the task. Just establish a DAO or ADO reference and a connection to your MDB and use Excel VBA to populate whatever you want.

I do Excel "reports" this way all the time.

ADO to SQL Server:

    Set con = New ADODB.Connection
    Set RS = New ADODB.Recordset
       
    SQL = "Select ...

    con.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;User ID=ReportUser;Data Source=OISSQLServer32;Initial Catalog=OIS"
    con.Open
    RS.Open SQL, con
    If Not RS.EOF Then....

You can use an xxx.udl file to build/test the connect string. Make a text file with .udl extension, setup connection, edit result with notepad to get the connect string.

 

[JerryKlmns]

Long tread, looks like we (I?) messed things up

The following should export one branch only to its excel workbook with the Branch No included in the file name

Function ExportBranch(strADPCompany As String, strLocationNo As String, _
                      lBranchNo As Long, dtFrom As Date, dtTo As Date) As Long
'Function returns the number of records exported to excel workbook
On Error GoTo Err_ExportBranch

    'Excel object variables
    Dim appExcel As Excel.Application
    Dim wbk As Excel.Workbook
    Dim sTemplate As String
    Dim sOutput As String       'Output string to build up
    Dim dbs As DAO.Database     'This is the database
    Dim rst As DAO.Recordset    'Retrieves value of field
    Dim sSQL As String          'SQL Statement
    Dim lRecords As Long
    DoCmd.Hourglass True
    
    'Start with clean file built from template file
    sTemplate = CurrentProject.Path & "\JournalEntryTest.xls"
    'with the Branch in the file name
    sOutput = CurrentProject.Path & "\JournalEntry" & lBranchNo & ".xls"
    If Dir(sOutput) <> "" Then Kill sOutput
    FileCopy sTemplate, sOutput
    
    'Create the Excel Application, Workbook and Worksheet and Database object
    Set appExcel = New Excel.Application            'Assigns objects to variables
    appExcel.Visible = True                         'Makes Excel session visible
    Set wbk = appExcel.Workbooks.Open(sOutput)
    
    sSQL = "SELECT E.GLDEPT, " & _
                  "GL.GL_Acct, " & _
                  "GL.GL_Subacct, " & _
                  "GL.GL_Dept, " & _
                  "GL.AccountDescription , " & _
                  "ADP.BranchNumber, " & _
                  "Sum(E.GROSS) As TheGross " & _
            "FROM tblAllADPCoCodes As ADP, " & _
                 "tblGLAllCodes As GL INNER JOIN tblAllPerPayPeriodEarnings As E ON " & _
                        "GL.Dept = E.GLDEPT " & _
            "GROUP BY E.GLDEPT, " & _
                     "GL.GL_Acct, " & _
                     "GL.GL_Subacct, " & _
                     "GL.GL_Dept, " & _
                     "GL.AccountDescription, " & _
                     "E.PG, " & _
                     "E.[LOCATION#], " & _
                     "ADP.BranchNumber, " & _
                     "E.CHECK_DT " & _
            "HAVING PG = '" & strADPCompany & "' AND " & _
                   "E.[LOCATION#] = '" & strLocationNo & "' AND " & _
                   "ADP.BranchNumber = " & lBranchNo & " AND " & _
                   "E.CHECK_DT Between #" & dtFrom & "# AND #" & dtTo & "#;"
    
    Set dbs = CurrentDb                                 'Opens database
    Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)   'Sets the record set to the query
    lRecords = 0
    With wbk.Sheets("JournalEntry")
        .Cells(3, 7).Value = lBranchNo
        If Not (rst.EOF And rst.BOF) Then
            rst.MoveFirst
            Do Until rst.EOF
                .Cells(lRecords + 15, 11).Value = rst.Fields("GL_Acct").Value
                .Cells(lRecords + 15, 12).Value = rst.Fields("GL_Subacct").Value
                .Cells(lRecords + 15, 15).Value = rst.Fields("TheGross").Value
                .Cells(lRecords + 15, 17).Value = rst.Fields("AccountDescription").Value
                lRecords = lRecords + 1
                rst.MoveNext
            Loop
            .Range("G3,K15,L15,O15,Q15").Column.AutoFit
        End If
    End With
'Close and save
    wbk.Close True

    ExportBranch = lRecords
    
Exit_ExportBranch:
'Cleanup all objects
On Error Resume Next
    If Not wbk Is Nothing Then
        wbk.Close False
        Set wbk = Nothing
    If Not appExcel Is Nothing Then
        appExcel.Quit
        Set appExcel = Nothing
    End If
    rst.Close
    Set rst = Nothing
    End If
    Set dbs = Nothing
    DoCmd.Hourglass False
    Exit Function

Err_ExportBranch:
    MsgBox "Error exporting Branch :" & lBranchNo , vbCritical, "Export Branch's Accounting"
    Resume Exit_ExportBranch

End Function

In a command button click event

Sub cmdExportBranchAccounting_Click()
dim lRecordsExported As Long
lRecordsExported = ExportBranch (Forms("frmJE").Controls("cboADPCompany").Value,  Forms("frmJE").Controls("cboLocationNo").Value, Forms("frmJE").Controls("txtBranchNo").Value, Forms("frmJE").Controls("txtFrom").Value, Forms("frmJE").Controls("txtTo").Value)

MsgBox "Branch :" & lBranchNo & " exported " & lRecordsExported & " records", vbInformation, "Export Branch's Accounting"
End Sub

Feel free to ask anything

 

[SHAWTY721]

JerryKlmns, will the following code export all the results of the query to the excel spreadsheet template that I have created.

 

[JerryKlmns]

SHAWTY721

That was my intention. Would you test both the correct result of the SQL statement and the execution of the function?

 

[SHAWTY721]

Okay I need to get the query output to calculate a sum based on the account and subaccount number Here is what the query result looks like.
Account Subaccount AcctDesc SumOfGross Check Date
60110 0100 ...... 4160 9/7/2007
60110 0100 ...... 4160 9/21/2007
60810 0900 ...... 842 9/21/2007
60810 0900 ...... 843.5 9/7/2007

I would like to have the result look like this in my spreadsheet in the appropriate field of course. I am trying to get the sum of SumOfGross based on the account and subaccout. I tried to take out the Check Date from the query but I can't because that is part of the parameters used in my query to get the correct results.
Account Subaccount AcctDesc SumOfGross
60110 0100 ...... 8320
60810 0900 ...... 1685.5

 

[lameid]

Get rid of the checkdate and use a Where clause instead of having.

    sSQL = "SELECT E.GLDEPT, " & _
                  "GL.GL_Acct, " & _
                  "GL.GL_Subacct, " & _
                  "GL.GL_Dept, " & _
                  "GL.AccountDescription , " & _
                  "ADP.BranchNumber, " & _
                  "Sum(E.GROSS) As TheGross " & _
            "FROM tblAllADPCoCodes As ADP, " & _
                 "tblGLAllCodes As GL INNER JOIN tblAllPerPayPeriodEarnings As E ON " & _
                        "GL.Dept = E.GLDEPT " & _
            "WHERE PG = '" & strADPCompany & "' AND " & _
                   "E.[LOCATION#] = '" & strLocationNo & "' AND " & _
                   "ADP.BranchNumber = " & lBranchNo & " AND " & _
                   "E.CHECK_DT Between #" & dtFrom & "# AND #" & dtTo & "# "
            "GROUP BY E.GLDEPT, " & _
                     "GL.GL_Acct, " & _
                     "GL.GL_Subacct, " & _
                     "GL.GL_Dept, " & _
                     "GL.AccountDescription, " & _
                     "E.PG, " & _
                     "E.[LOCATION#], " & _
                     "ADP.BranchNumber " & _
            ";"

 

[SHAWTY721]

Is there a way to automate other rows in excel based on the number of entries that are produced by the query. For example have a column named line increment by one for each result of the query that is exported to excel.