hey there,
here code that i've used plenty of time that steps thur a qry to determine which dataset to export to (MS Access to MS Excel), as well as the export to sheet name, cell ref and weather or not to export the qry result headers.
I am running into an issue using this code if the qry has parameters set on it?
it breaks at
with ther error of Few to Many Parameters ......expected 1
i'm clueless on how to solve this issue.
any suggestions?
TUK
here code that i've used plenty of time that steps thur a qry to determine which dataset to export to (MS Access to MS Excel), as well as the export to sheet name, cell ref and weather or not to export the qry result headers.
Code:
Private Sub ExportFromTable()
'note you must create a tbl ("tbl_Export_Qry_Loc_Data")
'and a qry that pulls from that tbl called ("qry_Export_Step_Thru")
'this is where you call the individual exports to the template....ie the qryResults
DoCmd.SetWarnings False
Dim rsExport As Recordset
Dim i As Integer
Set rsExport = CurrentDb.OpenRecordset("qry_Export_Step_Thru")
Dim flds As DAO.Fields
Dim fld As DAO.Field
Dim strExport As String
Dim strSheetName As String
Dim strCellRef As String
Dim strheader As String
Set flds = rsExport.Fields
Set fld = flds("qryName")
Set fldsWSName = rsExport.Fields
Set fldWSName = fldsWSName("SheetName")
Set fldsCellRef = rsExport.Fields
Set fldCellRef = fldsCellRef("CellRef")
Set fldsHeader = rsExport.Fields
Set fldHeader = fldsHeader("Header")
With rsExport
.MoveFirst
Do While Not .EOF
strExport = fld
strSheetName = fldWSName
strCellRef = fldCellRef
strheader = fldHeader
'''''''EXPORT ALL QRY RESULTS
'add the export stuff here
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim blnEXCEL As Boolean, blnHeaderRow As Boolean
blnEXCEL = False
' Replace True with False if you do not want the first row of
' the worksheet to be a header row (the names of the fields
' from the recordset)
blnHeaderRow = strheader
' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
' Change True to False if you do not want the workbook to be
' visible when the code is running
xlx.Visible = True
' Replace C:\Filename.xls with the actual path and filename
' of the EXCEL file into which you will write the data
Set xlw = xlx.Workbooks.Open("C:\Templates\Export_TEMPLATE.xlsm")
'turn off calcs
'Application.Calculation = xlManual
xlw.Application.Calculation = xlManual
xlw.Application.DisplayAlerts = False
' Replace WorksheetName with the actual name of the worksheet
' in the EXCEL file
' (note that the worksheet must already be in the EXCEL file)
Set xls = xlw.Worksheets(strSheetName)
'use for all cell in the sheet
'xlx.Cells.ClearContents
' Replace A1 with the cell reference into which the first data value
' is to be written
Set xlc = xls.Range(strCellRef) ' this is the first cell into which data go
Set dbs = CurrentDb()
' Replace QueryOrTableName with the real name of the table or query
' whose data are to be written into the worksheet
Set rst = dbs.OpenRecordset(strExport, dbOpenDynaset, dbReadOnly)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
If blnHeaderRow = True Then
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
Next lngColumn
Set xlc = xlc.Offset(1, 0)
End If
' write data to worksheet
Do While rst.EOF = False
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
' Close the EXCEL file while saving the file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
'turn calcs back on
xlw.Application.Calculation = xlAutomatic
xlw.Application.DisplayAlerts = True
xlw.Close True ' close the EXCEL file and save the new data
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing
''''table list EXPORTS COMPLETED
' this is the continuation of stepping thru the export table
.MoveNext
Loop
End With
End Sub
I am running into an issue using this code if the qry has parameters set on it?
it breaks at
Code:
Set rst = dbs.OpenRecordset(strExport, dbOpenDynaset, dbReadOnly)
with ther error of Few to Many Parameters ......expected 1
i'm clueless on how to solve this issue.
any suggestions?
TUK