Exporting Access Query to Excel

[TARHEELS721]

I am trying to send the results of a query that runs when I click a button on my form that is based on a parameter query. The code runs without any errors but nothing is exported into my excel spreadsheet and I can't figure out why does anyone see where I went wrong in my code. I am currently using DAO Recordset. Here is what my code looks like:
[code]

Private Sub btnJE_Click() 'Exports qryJE results into excel

On Error GoTo Err_btnJE_Click

MsgBox ExportQuery, vbInformation, "Export Finished"

Exit_btnJE_Click:
Exit Sub

Err_btnJE_Click:
MsgBox Err.Description, vbCritical, "Error"
Resume Exit_btnJE_Click

End Sub
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 tblAllPerPayPeriodEarnings " & vbCrLf & "WHERE PG = '" & Forms("frmJE").Controls("cboADPCompany").Value & "' AND ('LOCATION#') = '" & Forms("frmJE").Controls("cboLocationNo").Value & "' AND CHECK_DT Between #" & Forms("frmJE").Controls("txtFrom").Value & "# AND #" & Forms("frmJE").Controls("txtTo").Value & "#" & ";"


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:K100") = rst.Fields("Account")
.Sheets("JournalEntry").Range("L15:L100") = rst.Fields("Sub Account")
.Sheets("JournalEntry").Range("O15:O100") = rst.Fields("SumOfGROSS")
.Sheets("JournalEntry").Range("Q15:Q100") = rst.Fields("Account Description")
.Sheets("JournalEntry").Range("G3,K15:K100,L15:L10 0,O15:O100,Q15:Q100").Columns.AutoFit
.SaveAs CurrentProject.Path & "\" & rst.Fields("Branch Number") & ".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

[\Code]

[FishVal]

Hi, there.

The first question you should ask yourself having encountered such a kind of problem is - "Does my query return records?"

• Toggle breakpoint on the next line after
  

  sSQL="SELECT .......

• Get content of sSQL variable, e.g.
  

  ? sSQL 

  in immediate VBA window
• Copypaste it to query builder and run.

Check that first and will proceed with debugging of your code.

[TARHEELS721]

1. Okay I figured out why nothing was being inputted to the spreadsheet. All the records kept overwriting each other. But I have a new problem after making sure that the query returned values. Only one value is returned to the spreadsheet not all the results produced by the query. Also using the code below I get the error message: {Run-
time error '1004': Application-defined or object-defined error.} This same
message appears when I use the following pieces of code

.Cells(j,11).Value =
rst.Fields("GL_Acct").Value
.Cell(j,12).Value = rst.Fields("GL_Subacct").Value
.Cell(j,12).Value = rst.Fields("GROSS").Value
.Cell(j,12).Value = rst.Fields("AccountDescription").Value

2. Using this code I get a single record from the query to write to the spreadsheet. Also I receive this error message
"Run-time error '3265': Item not found in this collection." for the

.Range("O15").Value = rst.Fields("GROSS").Value

I have tried to change the name but nothing works. Any help would be greatly appreciated. I'm not sure what exactly is causing this error I have stepped through the code and everything I'm not sure if I have it coded wrong.

sSQL = "SELECT  tblAllPerPayPeriodEarnings.GLDEPT, tblGLAllCodes.GL_Acct,
tblGLAllCodes.GL_Subacct, tblGLAllCodes.GL_Dept, tblGLAllCodes.
AccountDescription , tblAllADPCoCodes.BranchNumber, Sum
(tblAllPerPayPeriodEarnings.GROSS) FROM tblAllADPCoCodes, tblGLAllCodes INNER
JOIN tblAllPerPayPeriodEarnings ON tblGLAllCodes.Dept =
tblAllPerPayPeriodEarnings.GLDEPT GROUP BY tblAllPerPayPeriodEarnings.GLDEPT,
tblGLAllCodes.GL_Acct, tblGLAllCodes.GL_Subacct, tblGLAllCodes.GL_Dept,
tblGLAllCodes.AccountDescription, tblAllPerPayPeriodEarnings.PG,
tblAllPerPayPeriodEarnings.[LOCATION#], tblAllADPCoCodes.BranchNumber,
tblAllPerPayPeriodEarnings.CHECK_DT HAVING PG = '" & Forms("frmJE").Controls
("cboADPCompany").Value & "' AND [LOCATION#] = '" & Forms("frmJE").Controls
("cboLocationNo").Value & "' AND BranchNumber = " & Forms("frmJE").Controls
("txtBranchNo").Value & " AND CHECK_DT Between #" & Forms("frmJE").Controls
("txtFrom").Value & "# AND #" & Forms("frmJE").Controls("txtTo").Value & "#"
& ";"
 
Do Until rst.EOF
   With wbk.Sheets("JournalEntry")
       .Range("G3") = rst.Fields("BranchNumber").Value
       .Range("K15").Value = rst.Fields("GL_Acct").Value
       .Range("L15").Value = rst.Fields("GL_Subacct").Value
       .Range("O15").Value = rst.Fields("GROSS").Value   'not finding value
       .Range("Q15").Value = rst.Fields("AccountDescription").Value
  End With
J = J + 1
rst.MoveNext
Loop

Thanks in advance!

[FishVal]

Hi, there.

Though you may expect the name of the field
.... Sum(tblAllPerPayPeriodEarnings.GROSS)...
will be [GROSS], it isn't so. Access will give it default name like [Expr1].
To explicitely name query field use "AS", e.g.

SELECT ..... Sum(tblAllPerPayPeriodEarnings.GROSS) AS GROSS ....
 

The code you've posted is not expected to work as it will put all records into the same cells. You have a right decision to use Cells object. Plz post the whole code using .Cells(J,..) references in the loop.

Regards,
Fish

[TARHEELS721]

Here is the updated version of the code. Now all I need to do is figure out how to get all the results from the query to write into the excel spreadsheet.

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 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 IRecords As Long
 
    Dim J As Long
 
    DoCmd.Hourglass True
 
    'Set to break on all errors
    On Error Resume Next
 
    '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            'Assigns objects to variables
    appExcel.Visible = True                         'Makes Excel session visible
    Set wbk = appExcel.Workbooks.Open(sOutput)
 
sSQL = "SELECT  tblAllPerPayPeriodEarnings.GLDEPT, tblGLAllCodes.GL_Acct, tblGLAllCodes.GL_Subacct, tblGLAllCodes.GL_Dept, tblGLAllCodes.AccountDescription , tblAllADPCoCodes.BranchNumber, Sum(tblAllPerPayPeriodEarnings.GROSS) As GROSS FROM tblAllADPCoCodes, tblGLAllCodes INNER JOIN tblAllPerPayPeriodEarnings ON tblGLAllCodes.Dept = tblAllPerPayPeriodEarnings.GLDEPT GROUP BY tblAllPerPayPeriodEarnings.GLDEPT, tblGLAllCodes.GL_Acct, tblGLAllCodes.GL_Subacct, tblGLAllCodes.GL_Dept, tblGLAllCodes.AccountDescription, tblAllPerPayPeriodEarnings.PG, tblAllPerPayPeriodEarnings.[LOCATION#], tblAllADPCoCodes.BranchNumber, tblAllPerPayPeriodEarnings.CHECK_DT HAVING PG = '" & Forms("frmJE").Controls("cboADPCompany").Value & "' AND [LOCATION#] = '" & Forms("frmJE").Controls("cboLocationNo").Value & "' AND BranchNumber = " & Forms("frmJE").Controls("txtBranchNo").Value & " AND CHECK_DT Between #" & Forms("frmJE").Controls("txtFrom").Value & "# AND #" & Forms("frmJE").Controls("txtTo").Value & "#" & ";"
 
    Set dbs = CurrentDb                                 'Opens database
    Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)   'Sets the record set to the query
 
Do Until rst.EOF
    With wbk.Sheets("JournalEntry")
    J = 15
    IRecords = IRecords + 1
        .Range("G3") = rst.Fields("BranchNumber").Value
        .Cells(J, 11).Value = rst.Fields("GL_Acct").Value
        .Cells(J, 12).Value = rst.Fields("GL_Subacct").Value
        .Cells(J, 15).Value = rst.Fields("GROSS").Value
        .Cells(J, 17).Value = rst.Fields("AccountDescription").Value
 
    End With
J = J + 1
rst.MoveNext
Loop
 
'wbk.Save
wbk.Close True
 
 
    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 Function

[FishVal]

Hi, there.

Take line 42
J=15
and put it before line 40
Do Untill ....

[TARHEELS721]

I was wondering if there is a way to total within a totals query. I mean the results of my query list everything out depending on account numbers and check date. What I want to do is have the amount be totalled based on account number and sub account number. So I dont have multiple entries of the same account and sub account number.

Hi, there.

Take line 42
J=15
and put it before line 40
Do Untill ....

[TARHEELS721]

View next message wrong post

[TARHEELS721]

I have a query that produces this output and I want to be able to get the sum of a field based on the Account & Subaccount matching. 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

This is the results that appear on the excel spreadsheet:
Account Subaccount AcctDesc SumOfGross
60110 0100 ...... 8320
60810 0900 ...... 1684
60810 0900 ...... 1687

I would like to have the result look like this in my spreadsheet
Account Subaccount AcctDesc SumOfGross
60110 0100 ...... 8320
60810 0900 ...... 1685.5

I was wondering if there is a way to total within a totals query. I mean the results of my query list everything out depending on account numbers and check date. What I want to do is have the amount be totalled based on account number and sub account number. So I dont have multiple entries of the same account and sub account number.

[TARHEELS721]

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.

[TARHEELS721]

Is there any particular reason the results of the 'Sum(tblAllPerPayPeriodEarnings.GROSS) As Gross' are being doubled.

sSQL = "SELECT tblAllPerPayPeriodEarnings.GLDEPT, tblGLAllCodes.GL_Acct, tblGLAllCodes.GL_Subacct, tblGLAllCodes.GL_Dept, tblGLAllCodes.AccountDescription , tblAllADPCoCodes.BranchNumber, Sum(tblAllPerPayPeriodEarnings.GROSS) As GROSS FROM tblAllADPCoCodes, tblGLAllCodes INNER JOIN tblAllPerPayPeriodEarnings ON tblGLAllCodes.Dept = tblAllPerPayPeriodEarnings.GLDEPT WHERE  PG = '" & Forms("frmJE").Controls("cboADPCompany").Value & "' AND [LOCATION#] = '" & Forms("frmJE").Controls("cboLocationNo").Value & "' AND BranchNumber = " & Forms("frmJE").Controls("txtBranchNo").Value & " AND CHECK_DT Between #" & Forms("frmJE").Controls("txtFrom").Value & "# AND #" & Forms("frmJE").Controls("txtTo").Value & "# GROUP BY tblAllPerPayPeriodEarnings.GLDEPT, tblGLAllCodes.GL_Acct, tblGLAllCodes.GL_Subacct, tblGLAllCodes.GL_Dept, tblGLAllCodes.AccountDescription, tblAllPerPayPeriodEarnings.PG, tblAllPerPayPeriodEarnings.[LOCATION#], tblAllADPCoCodes.BranchNumber ORDER BY tblGLAllCodes.GL_Acct;"

[FishVal]

Hi, there.

You have tables [tblAllADPCoCodes] and [tblGLAllCodes] joined without criteria specified. This will give you Cartesian product - records with all possible combinations of the tables fields. Please explain what data is stored in both tables and what you are expecting to obtain joining the tables together.

P.S.
Tip: when building a complex query based on table joins try to do it adding tables and criteria stepwise controlling on each step whether the query returns what it is supposed to return.

P.P.S. Sorry for having been "ignoring" your posts. I've got many things to do.

[TARHEELS721]

Okay, I have the correct fields exporting into the excel spreadsheet. But now I need to be able to add the values of multiple fields of the query to be inserted into the same field so that I don't have to create multiple procedures and have to extra programming to get the result that I need. Here is what the code looks like:

Public Function ExportQuery() As String     'Function creates query result set the exports results to excel based on form selections
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 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 that generates output
    Dim IRecords As Long        'Counts # of records returned by query
    Dim J As Long               'Initializes line where data entry begins
 
    Dim strPeriod As String
    Dim strYear As String
 
    DoCmd.Hourglass True
 
    'Set to break on all errors
    On Error Resume Next
 
    'Start with clean file built from template file
    sTemplate = CurrentProject.Path & "\JournalEntry.xls"       'file that spreadsheets are based off of
    sOutput = CurrentProject.Path & "\Journal Entry " & txtBranchNo & " " & txtDescription & " .xls"    'This is how the result of the query is saved by excel
    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 tblAllPerPayPeriodEarnings.GLDEPT, tblGLAllCodes.GL_Acct, tblGLAllCodes.GL_Subacct, tblGLAllCodes.GL_Dept, tblGLAllCodes.AccountDescription, tblAllADPCoCodes.BranchNumber, Sum(tblAllPerPayPeriodEarnings.GROSS) As GROSS, tblGLAllCodes.Ins, tblGLAllCodes.Tax FROM (tblGLAllCodes INNER JOIN tblAllPerPayPeriodEarnings ON tblGLAllCodes.Dept=tblAllPerPayPeriodEarnings.GLDEPT) INNER JOIN tblAllADPCoCodes ON (tblAllPerPayPeriodEarnings.PG=tblAllADPCoCodes.ADPCompany) AND (tblAllPerPayPeriodEarnings.[LOCATION#]=tblAllADPCoCodes.LocationNumber)  WHERE  PG = '" & Forms("frmJE").Controls("cboADPCompany").Value & "' AND [LOCATION#] = '" & Forms("frmJE").Controls("cboLocationNo").Value & "' AND BranchNumber = " & Forms("frmJE").Controls("txtBranchNo").Value & " AND CHECK_DT Between #" & Forms("frmJE").Controls("txtFrom").Value & "# AND #" & Forms("frmJE").Controls("txtTo").Value & "# " & _
"GROUP BY tblAllPerPayPeriodEarnings.GLDEPT, tblGLAllCodes.GL_Acct, tblGLAllCodes.GL_Subacct, tblGlAllCodes.GL_Dept, tblGLAllCodes.AccountDescription, tblGLAllCodes.Ins, tblGLAllCodes.Tax, tblAllADPCoCodes.BranchNumber ORDER BY tblGLAllCodes.GL_Acct, tblGLAllCodes.GL_Subacct;"
 
    Set dbs = CurrentDb                                 'Opens database
    Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)   'Sets the record set to the query
 
J = 15        'Sets J equal to first row where data is to be entered
 
Do Until rst.EOF
    With wbk.Sheets("JournalEntry")
    IRecords = IRecords + 1
        .Range("G3") = rst.Fields("BranchNumber").Value               'Company
        .Cells(J, 11).Value = rst.Fields("GL_Acct").Value             'Account
        .Cells(J, 12).Value = rst.Fields("GL_Subacct").Value          'Sub Account
        .Cells(J, 15).Value = rst.Fields("GROSS").Value               'Amount
        .Cells(J, 17).Value = rst.Fields("AccountDescription").Value  'Description
        .Cells(J, 3).Value = IRecords                                 'Line
        .Cells(J, 4).Value = Year(Now())                              'Year
        .Cells(J, 5).Value = .Range("G4")                             'System
        .Cells(J, 6).Value = .Range("G5")                             'Journal
        .Cells(J, 7).Value = Month(Now()) - 1                         'Period
        .Cells(J, 8).Value = .Range("G8")                             'Type
        .Cells(J, 9).Value = rst.Fields("BranchNumber").Value         'To Company
        .Cells(J, 10).Value = .Range("G3") & "" & ("600")             'Accounting Unit
        .Cells(J, 18).Value = .Range("G10")                           'Auto Reverse
        .Cells(J, 2).Value = ("A")                                    'Func Code
 
    End With
 
J = J + 1       'Moves to next row each time through loop
rst.MoveNext
Loop
 
'Saves & closes workbook
wbk.Close True
 
    ExportQuery = "Total of " & IRecords & " rows processed."       'Displays total number of records processed & that were sent to excel
 
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 Function
 
Private Sub btnCloseJE_Click() 'Closes Journal Entry Form
On Error GoTo Err_btnCloseJE_Click
 
 
    DoCmd.Close
 
Exit_btnCloseJE_Click:
    Exit Sub
 
Err_btnCloseJE_Click:
    MsgBox Err.Description
    Resume Exit_btnCloseJE_Click
 
End Sub

Where I need to be able to add Ins, Tax Account Numbesr to the Account column in the spreadsheet that is being used.