3061 Error (1 Viewer)

[cyd44]

I am trying to copy the data from an access query into excel and am using DAO.Recordset to capture the data but am getting a 3061 error. I am a newbie to recordsets and am unsure waht the problem is. I am calling a fuction called exportdata and the first lines of this are:-

Private Function ExportData(strQuery As String)
Dim intR As Integer
Dim rs As DAO.Recordset
 
    Set db = CurrentDb()
    Set rs = db.OpenRecordset(strQuery, dbOpenDynaset) (THIS Line CAUSES ERROR 3061):mad:
    rs.MoveLast 'moves to the last record
    rs.MoveFirst 'moves back to the first record
 
    If Not (rs.BOF And rs.EOF) Then
 
         xl.Sheets(Sheet1).Select
        Else
        'There are no records
        MsgBox "There are no records for " & strQuery

The error says too few parameters expected 1 and points to SET rs line? I am at a complete loss as the strQry is showing as set to qryChoose_Patient and I can open this qry in access to show the records.

Can someone please point out where I am going wrong?

 

[bob fitz]

I think you need to take a look at the string value held in strQuery.

 

[cyd44]

I think you need to take a look at the string value held in strQuery.

HI Bob,

The string value is showing the name of the access qry IE qryChoose_Patient_Diary. I can also open the qry itself and does show 147 rows of data?

I will take another look to be sure but I am confident it is right. If I find it is wrong I will come straight back

 

[boblarson]

If you are trying to export to Excel, I have some prewritten functions you might find useful instead of trying to come up with them yourself:

http://www.btabdevelopment.com/ts/default.aspx?PageId=10

But You need to post the SQL of the query so we can see what is there. Because you are probably using some sort of form reference which is causing the problem.

 

[cyd44]

If you are trying to export to Excel, I have some prewritten functions you might find useful instead of trying to come up with them yourself:

http://www.btabdevelopment.com/ts/default.aspx?PageId=10

But You need to post the SQL of the query so we can see what is there. Because you are probably using some sort of form reference which is causing the problem.

Thanks Again,

I have trued your posted function above and am calling this from an eveny sub on a form buttom. Unfortunitely I am still gett the 3061 error too few parameters expected 1.

I have cut and pasted the Public Function SendTQ2ExcelSheet(strTQName As String, strSheetName As String) and called it from my form using the qry name & spreadsheet path.

 

[boblarson]

Thanks Again,

I have trued your posted function above and am calling this from an eveny sub on a form buttom. Unfortunitely I am still gett the 3061 error too few parameters expected 1.

I have cut and pasted the Public Function SendTQ2ExcelSheet(strTQName As String, strSheetName As String) and called it from my form using the qry name & spreadsheet path.

Yes, you need to post the SQL for your query or queries if that query is based on another one. If you have parameters set for any of them, you will need to add those to the querie's Parameters collection.

 

[cyd44]

Yes, you need to post the SQL for your query or queries if that query is based on another one. If you have parameters set for any of them, you will need to add those to the querie's Parameters collection.

Have reached the point of getting very tired and will make more stupid mistakes if I carry on tonight. Just to let you know, the form I am using gets the records from a table based upon a query that selects based upon a form variable (IE Forms!Form!Var). I am thinging that this might be the problem but if so, How can I get the info I need into a recordset when I need a filtered result?

Can I come back to you tomorrow as it is now 11pm?

 

[cyd44]

Yes, you need to post the SQL for your query or queries if that query is based on another one. If you have parameters set for any of them, you will need to add those to the querie's Parameters collection.

Hi Bob,

Am back awake now (but still frustrated). I have cut and paste an example from the link you gave me and it worked the first time I used it but am now getting a 1004 error (Select Method of Range Class Failed ).

Here is the full code used for the function

Public Function SendToSheet(frm As Form, strSheetName As String, strFilePath As String)
' frm is the name of the form used to query table
' strSheetName is the name of the sheet to copy data to in the XL workbook
' strFilePath is the spreadsheet to use
 
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim xMacNm As String
    Dim strPath As String
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    xMacNm = "Macro2"
    On Error GoTo err_handler
 
 
    strPath = strFilePath
 
 
    Set rst = frm.RecordsetClone
 
 
    Set ApXL = CreateObject("Excel.Application")
 
 
    Set xlWBk = ApXL.Workbooks.Open(strPath)
 
 
    ApXL.Visible = True
 
    Set xlWSh = xlWBk.Worksheets(strSheetName)
 
    xlWSh.Range("A1").Select ***THIS IS WHERE THE ERROR POINTS****
 
    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
 
 
 
    ' Formatting
    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
 
    'Run the macro on XL Workbook
    xlWSh.Application.Run "'" & strPath & "'!'" & xMacNm & "'"
    rst.Close
    Set rst = Nothing
 
Exit_SendToSheet:
    Exit Function
 
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendToSheet
End Function

It sort of worked the first time i ran it but now it complains with the error?

Help would be greatly appreciated

 

[vbaInet]

Just wondering why you are needing to Select the range when you can work with the range without selecting it?

 

[cyd44]

Just wondering why you are needing to Select the range when you can work with the range without selecting it?

Hi there,

Thats an interesting point. Being a newbie, I am just using an example function recomended and the range selection was included? I I take out the range, will it atomatically copy and paste at A1 cell?

 

[vbaInet]

I don't want to alter or interfer with Bob's code but comment out that line of code that is failing and re-run it.

If other Range().Select lines of code fail, try selecting the worksheet before selecting the range.

 

[boblarson]

Written quite a while ago and I need to update that code. But one quick way to overcome this is just to add

xlWsh.Activate

before the offending line of code.

 

[cyd44]

Written quite a while ago and I need to update that code. But one quick way to overcome this is just to add

xlWsh.Activate

before the offending line of code.

Thanks to both of you. Bob, I put in the Activate Code as suggested and it worked fine. Without the Range constuct Access was putting Feld headings on different worksheets (dont know why but your code solved this).

For clarity should anyone want to use this going forward I enclose the full code as amended and which has worked for me.

FINAL CODE IS

Option Compare Database
Option Explicit
Public Function SendToSheet(frm As Form, strSheetName As String, strFilePath As String)
' frm is the name of the form used to query table
' strSheetName is the name of the sheet to copy data to in the XL workbook
' strFilePath is the spreadsheet to use
' To Call the function use Call SendToSheet(Me, MySheet, MyPath)
 
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim xMacNm As String
    Dim xMacNm1 As String
    Dim strPath As String
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    xMacNm = "Macro2"
    xMacNm1 = "Macro1"
    On Error GoTo err_handler
 
 
    strPath = strFilePath
 
 
    Set rst = frm.RecordsetClone
 
 
    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("A1").CopyFromRecordset rst
 
    xlWSh.Range("1:1").Select
 
 
 
    ' Formatting
    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
 
    ' Run Macro of Worksheet to produce graphs
    xlWBk.Application.Run "'" & strPath & "'!'" & xMacNm & "'"
 
    ' 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.Activate
    xlWSh.Range("A1").Select
 
    rst.Close
    Set rst = Nothing
    'Run 2nd Macro to Clear the import sheet (prevent any error when function is re-used)
     xlWBk.Application.Run "'" & strPath & "'!'" & xMacNm1 & "'"
 
Exit_SendToSheet:
    Exit Function
 
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendToSheet
End Function

Many thanks to all who have given advise. Am happy to close this question now.

By the way guys, have learnt a great deal over the last couple of days.