Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Exporting Access Query to Excel 3

Status
Not open for further replies.

SHAWTY721

Programmer
Aug 16, 2007
116
US
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
 
Okay after I remove the parenthesis I get this message.

Run-time error '3075': Syntax error (missing operator) in query expression ‘tblGLAllCodes.Dept = tblAllPerPayPeriodEarnings.GLDEPT INNER JOIN tblAllPerPayPeriodEarnings ON tblAllADPCoCodes.ADPCompany = tblAllPerPayPeriodEarnings.PG INNER JOIN tblAllPerPayPeriodEarnings ON tblAllADPCoCodes.LocationNumber = tblAllPerPayPeriodEarnings.[LCOATION#]’
 
Please Read up on joins. I think this is what you intended.

Code:
sSQL = "SELECT tblAllPerPayPeriodEarnings.GLDEPT, " &_
	"tblGLAllCodes.GL_Acct, " &_
	"tblGLAllCodes.GL_Subacct, " &_
	"tblGLAllCodes.GL_Dept, " &_
	"tblGLAllCodes.AccountDescription , " &_
	"tblAllADPCoCodes.BranchNumber, " &_
	"Sum(tblAllPerPayPeriodEarnings.GROSS) As GROSS " &_
"FROM tblAllADPCoCodes " &_
	"INNER JOIN tblGLAllCodes " & _
	  "ON tblGLAllCodes.Dept = tblAllPerPayPeriodEarnings.GLDEPT " &_
	"INNER JOIN tblAllPerPayPeriodEarnings ON " & _
	  "tblAllADPCoCodes.ADPCompany = tblAllPerPayPeriodEarnings.PG  " &_
		"AND tblAllADPCoCodes.LocationNumber = tblAllPerPayPeriodEarnings.[LOCATION#])   " &_
	"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 ORDER BY tblGLAllCodes.GL_Acct;"
 
If I wanted to use the Format Function with my code is there any special way that I need to code the section of code that I am trying to format. In access it looks like this

Format([CHECK_DT], "mm")
Format([CHECK_DT], "yyyy")

I am trying to add the format function so I can have two of the fields in the spreadsheet show the same month and year that appear on the form in access before the information is exported into excel.
 
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:

Code: ( text )
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.GLDE PT) INNER JOIN tblAllADPCoCodes ON (tblAllPerPayPeriodEarnings.PG=tblAllADPCoCodes.AD PCompany) 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
 
>Where I need to be able to add Ins, Tax Account Numbesr to the Account column

You need them to be inside the same cell?

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

or am I missing something?

Some amendments now
[ul]
[li] The wks is not used at all so don't Dim it.[/li]
[li] Since you Dim strYear As String, set it to the Year(Now()) and use it inside the With wbk.Sheets("JournalEntry") ... End With block for .Cells(J, 4)[/li]
[li] The same goes for the strPeriod [/li]
[li] You don't close the rst before destroying it![/li]
[/ul]
 
No not the same cell but have the values write to the same column of the spreadsheet
GL_Acct GL_Subacct GROSS Ins Tax
60110 0100 8320 62200 62500
60810 0900 1670.5 62200 62500
 
Having the GL_Acct, Ins, & Tax #'s write to the Account column in the specified spreadsheet.
 

I don't follow you!

GL_Acct is in cell (J, 11)
Ins is in cell (J, ??)
Tax is in cell (J, ??)

Same column but which row?
 
I need to have the results written into the column in the following rows as the query loops through until no more records are found matching the criteria set in the query.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top