CurrentDb.OpenRecordset

Triscuit

Triscuit

Registered User.
Local time
Today, 13:52
Joined
Jul 20, 2010
Messages
27
Hello,

I'm trying to export a query of my database structure to an excel file:

I have a Query based on form control and a form with a combobox and Command button to execute export.

I'm having problems opening the SQL statement or query in the OpenRecordset command.

I get two different errors:
1. When using the query as the variable:
Run-time error 3061
Too few Parameters expected 1.
2. When using the vba string as the variable:
Run-time error 3141:
The SELECT statement includes a use of a reserved word, punctuation error or misspelling.

My SQL code is as follows:
Code: 
SELECT tblAnalysisInformation.txtClientNumID AS Sys_Sample_Code, "lab_lea" AS Lab_Name_Code, tblAnalysisInformation.txtClientNumID AS Lab_Sample_Id, IIf(tblAnalysisInformation.txtQC="Normal","N","IB") AS Sample_Type_Code, "SW 3810" AS Lab_Anl_Method_Name, tblChemicalsTested.txtCAS AS Cas_Rn, tblChemicalsTested.txtName AS Chemical_Name, IIf(tblSampleInformation.txtMatrix="Solid","ug/kg","mg/m3") AS Result_Unit, "TRG" AS Result_Type_Code, IIf(tblAnalysisResult.txtDetect="Y","Y","N") AS Detect_Flag, tblSampleInformation.numInitDilut AS Dilution_Factor, tblSampleInformation.txtMatrix AS Sample_Matrix_Code, "N" AS Total_or_Dissovled, tblAnalysisInformation.dateAnalyzedOn AS Analysis_Date, tblAnalysisInformation.timeAnalyzed AS Analysis_Time, tblSampleInformation.txtCaseNum AS Lab_Batch_Number
FROM tblSampleInformation INNER JOIN (tblChemicalsTested INNER JOIN (tblAnalysisInformation INNER JOIN tblAnalysisResult ON tblAnalysisInformation.txtLabNum = tblAnalysisResult.txtLabnum) ON tblChemicalsTested.txtCAS = tblAnalysisResult.txtCas) ON tblSampleInformation.txtClientNumID = tblAnalysisInformation.txtClientNumID
WHERE (((tblSampleInformation.txtCaseNum)=[Forms]![frmEZEDD]![cboBatchGroup]));

I have also tried to save the SQL statement in the function itself
by doing:
Code: 
Dim strSQL As String
strSQL = "SELECT tblAnalysisInformation.txtClientNumID AS Sys_Sample_Code, 'lab_lea' AS Lab_Name_Code, tblAnalysisInformation.txtClientNumID AS Lab_Sample_Id, IIf(tblAnalysisInformation.txtQC='Normal','N','IB') AS Sample_Type_Code, 'SW 3810' AS Lab_Anl_Method_Name, tblChemicalsTested.txtCAS AS Cas_Rn, tblChemicalsTested.txtName AS Chemical_Name, IIf(tblSampleInformation.txtMatrix='Solid','ug/kg','mg/m3') AS Result_Unit, 'TRG' AS Result_Type_Code, IIf(tblAnalysisResult.txtDetect='Y','Y','N') AS Detect_Flag, tblSampleInformation.numInitDilut AS Dilution_Factor, tblSampleInformation.txtMatrix AS Sample_Matrix_Code, 'N' AS Total_or_Dissovled, tblAnalysisInformation.dateAnalyzedOn AS Analysis_Date, tblAnalysisInformation.timeAnalyzed AS Analysis_Time, tblSampleInformation.txtCaseNum AS Lab_Batch_Number" & _
"FROM tblSampleInformation INNER JOIN (tblChemicalsTested INNER JOIN (tblAnalysisInformation INNER JOIN tblAnalysisResult ON tblAnalysisInformation.txtLabNum = tblAnalysisResult.txtLabnum) ON tblChemicalsTested.txtCAS = tblAnalysisResult.txtCas) ON tblSampleInformation.txtClientNumID = tblAnalysisInformation.txtClientNumID" & _
"WHERE (((tblSampleInformation.txtCaseNum)=[Forms]![frmEZEDD]![cboBatchGroup]))"


The export function is called in the On Click property of the command button and the variable are passed through by
Code: 
Call SendTQ2XLWbSheet(strSQL, "sheetName", "C:\Documents and Settings\akoerner\My Documents\EZEDD Output\'" & Forms!frmEZEDD!cboBatchGroup & "'")

to the function:

Code: 
Public Function SendTQ2XLWbSheet(strTQName As String, strSheetName As String, strFilePath As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
' strFilePath is the name and path of the file you want to send this data into.

    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As Field

    Dim strPath As String

    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107

    On Error GoTo err_handler


    strPath = strFilePath

    Set rst = CurrentDb.OpenRecordset(strTQName)
 
In code:

Code: 
Dim strSQL As String
strSQL = "SELECT tblAnalysisInformation.txtClientNumID AS Sys_Sample_Code, 'lab_lea' AS Lab_Name_Code, tblAnalysisInformation.txtClientNumID AS Lab_Sample_Id, IIf(tblAnalysisInformation.txtQC='Normal','N','IB') AS Sample_Type_Code, 'SW 3810' AS Lab_Anl_Method_Name, tblChemicalsTested.txtCAS AS Cas_Rn, tblChemicalsTested.txtName AS Chemical_Name, IIf(tblSampleInformation.txtMatrix='Solid','ug/kg','mg/m3') AS Result_Unit, 'TRG' AS Result_Type_Code, IIf(tblAnalysisResult.txtDetect='Y','Y','N') AS Detect_Flag, tblSampleInformation.numInitDilut AS Dilution_Factor, tblSampleInformation.txtMatrix AS Sample_Matrix_Code, 'N' AS Total_or_Dissovled, tblAnalysisInformation.dateAnalyzedOn AS Analysis_Date, tblAnalysisInformation.timeAnalyzed AS Analysis_Time, tblSampleInformation.txtCaseNum AS Lab_Batch_Number " & _
"FROM tblSampleInformation INNER JOIN (tblChemicalsTested INNER JOIN (tblAnalysisInformation INNER JOIN tblAnalysisResult ON tblAnalysisInformation.txtLabNum = tblAnalysisResult.txtLabnum) ON tblChemicalsTested.txtCAS = tblAnalysisResult.txtCas) ON tblSampleInformation.txtClientNumID = tblAnalysisInformation.txtClientNumID " & _
"WHERE (((tblSampleInformation.txtCaseNum)=[COLOR=red][B]" &[/B][/COLOR] [COLOR=blue][B]Forms!frmEZEDD.cboBatchGroup[/B][/COLOR] [COLOR=red][B]& "[/B][/COLOR]))"

I had to add a couple of spaces too between your end of line and the quote mark just before the continuation character. Otherwise your lines run together.
 
I still get the same 3141 error when run.
On the line:

Code: 
Set rst = CurrentDb.OpenRecordset(strTQName)
 
Reviving this post because I'm having the same sort of issue. I'm am exporting the results of a query to an exisiting worksheet in an Excel file. Eventually would like to specify a Cell Range but for now I'd just like to be able to make this work. It seems that others have used this code successfully but I continue to get the Too Few Perameters: 1 error.

Any help would be greatly appreciated. My VBA knowledge is limited but growing by the day. Using Office10 if that helps.

My Module:

Code: 
Public Function SendTQ2XLWbSheet(strTQName As String, strSheetName As String, strFilePath As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
 
' strFilePath is the name and path of the file you want to send this data into.
 
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim strPath As String
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    'On Error GoTo err_handler
 
 
    strPath = strFilePath
 
 
    Set rst = CurrentDb.OpenRecordset(strTQName)
 
    Set ApXL = CreateObject("Excel.Application")
 
 
    Set xlWBk = ApXL.Workbooks.Open(strPath)
 
    ApXL.Visible = True
 
    Set xlWSh = xlWBk.Worksheets(strSheetName)
    xlWSh.Activate
 
    xlWSh.Range("A1").Select
 
    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next
 
    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
 
    xlWSh.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
 
    ApXL.Selection.Font.Bold = True
 
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
 
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
 
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
 
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
 
    rst.Close
 
    Set rst = Nothing
 
Exit_SendTQ2XLWbSheet:
    Exit Function
 
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendTQ2XLWbSheet
End Function

And my call function:

Code: 
Private Sub Command56_Click()
Call SendTQ2XLWbSheet("qryExportToExcel", "TFDNA311SampleInfo", "C:\.....\TF-DNA311_Template.xlsx")
End Sub

Edited to add that the debugged line is:

Code: 
Set rst = CurrentDb.OpenRecordset(strTQName)
 
Maybe I'm Missing it, but I don't see strTQName Dimensioned or passed a table name. You have to assign the name of the table to it.

EDIT: My mistake. I see it now. My browser was screwing up again. lol! Sorry.

Does the query qryExportToExcel contain any data? Also, you have to define a set type (dbOpenDynaset).
 
Last edited:
Yes, and on further investigation I realized that it is a query that has criteria [Enter Plate Name]. When I deleted the criteria from the query it worked like a charm but I NEED it to filter this data before exporting it...ie it needs to be user defined not defined withing the module.

any thoughts as to how I might go about this...I'm still looking around the forums for an answer...

Thank you for the quick reply!
 
I need the user to be able to put in a plate name for instance WAP001 would return all the samples that are on that plate and export that data to an existing range on an existing worksheet in an Excel file.

This is my ultimate goal.
 
Can you adapt the following:
Code: 
Dim strSQL As String
strSQL = "SELECT * FROM qryExportToExcel WHERE PlateName='" & TextBox & "';"
Set RST = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

Of course, replacing PlateName with your field and textbox with your control name.
 
The problem is that you need to specify the parameters.

So, Macropheliac's solution should work if you remove the criteria from inside the query and rely on the criteria being in code. Or you should be able to, if your query was something like this:

Select Field1, Field2, PlateName, Field3
From TableName
Where PlateName = [Forms]![FormNameHere]![ControlNameHere]

changing it to

PARAMETERS [Forms]![FormNameHere]![ControlNameHere] TEXT( 255 );
Select Field1, Field2, PlateName, Field3
From TableName
Where PlateName = [Forms]![FormNameHere]![ControlNameHere]
 
Bob is absolutely correct. I just like filtering in code because you may want to filter by something else at some point.
 
Macropheliac said:
Bob is absolutely correct. I just like filtering in code because you may want to filter by something else at some point.
Click to expand...
I like doing that too as it helps me keep from going nuts with parameters. LOL
 
Thanks you guys! I'm excited to try this now! This might be a dumb question but should I code that on the module or on the query?
 
In your code... instead of opening the entire table as the recordset, define the sql above it and open it that way.
 
What is the TEXTBOX portion of the statement supposed to do? I'm having difficulty getting it to run with no errors. Latest error: Run-time error 3075 Syntax error (missing operator) in query expression Plate Name ='".

and the debugged line:

Code: 
 Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

and my code:

Code: 
strSQL = "SELECT * FROM qryExportToExcel WHERE Plate Name='" & PlateName & "';"

I'm not actually sure which control I should be using in place of TEXTBOX because I don't exactly know what that portion of the code is supposed to do when it runs....

sorry I am trying to work through this logically but my lack of coding knowledge is beginning to show. :(
 
It's the control where your user is entering the plate. I assumed it was a control on a form. If not, how are they entering the plate name?
 
Last edited:
And that made sense, so I made a small form with a command button.

Control on form = PlateName. The command button on click code:

Code: 
Private Sub Command2_Click()
Call SendTQ2XLWbSheet("qryExportToExcel", "TFDNA311SampleInfo", "C:.....\TF-DNA311_Template.xlsx")
End Sub

and the module code:

Code: 
Public Function SendTQ2XLWbSheet(strTQName As String, strSheetName As String, strFilePath As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to

' strFilePath is the name and path of the file you want to send this data into.

    
    
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim strPath As String
    
    Dim strSQL As String
    
    
    

    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    'On Error GoTo err_handler
    strSQL = "SELECT * FROM qryExportToExcel WHERE Plate Name='" & PlateName & "';"

    strPath = strFilePath
 
    
    
    Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
 
    Set ApXL = CreateObject("Excel.Application")
 

    Set xlWBk = ApXL.Workbooks.Open(strPath)
 
    ApXL.Visible = True
 
    Set xlWSh = xlWBk.Worksheets(strSheetName)

    xlWSh.Activate
 
    xlWSh.Range("A1").Select
 
    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next

    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst

    xlWSh.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With

    ApXL.Selection.Font.Bold = True

    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With

    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select

    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit

    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
 
    rst.Close

    Set rst = Nothing
 
Exit_SendTQ2XLWbSheet:
    Exit Function

err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendTQ2XLWbSheet
End Function

Run-time error 3075 Syntax error (missing oporator) in query expression 'Plate Name='".

Debugger found:

Code: 
   Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
 
Something has a space so it needs square brackets (one reason why you should consider NOT using spaces or special characters, other than an underscore _ in your field or object names).

strSQL = "SELECT * FROM qryExportToExcel WHERE Plate Name='" & PlateName & "';"
Needs to be:
strSQL = "SELECT * FROM qryExportToExcel WHERE [Plate Name]='" & PlateName & "';"
 
Something so simple and it worked perfectly. Thank you. Now the code opens my Excel file and runs the query but only exports the headers from the query into the worksheet and kicks back a runtime error 3020 No current record. Even tho the query works fine by itself.

The debbuger says it's at:

Code: 
rst.MoveFirst

Any ideas on this one?
 
That error indicates no matching records were found. Check your query is actually looking for recoeds that exist.
 
You must log in or register to reply here.

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom