Results 1 to 5 of 5
  1. #1
    Join Date
    May 2008
    Posts
    9

    Unanswered: Run Access Query from Excel

    Hi All-

    I would appreciate any help on this. The attached code worked initially but it did not pull all records from the recordset, rs; only 180 of the 250 records was output to the excel sheet. Currently, when I run the macro, all it does is output only the very first field name and nothing else. I didn't change anything since I ran it last time. I get this error too: "Data and table creation error"
    Is there a better way to output all records of the recordset, rs?


    Sub RawLotInput()

    Dim dbs As Database
    Dim rs As Recordset
    Dim Ws As Worksheet
    Dim Path As String
    Dim strSQL As String

    On Error GoTo ErrorHandler

    ThisWorkbook.Activate
    '' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    ''Open the database

    Path = "C:\Documents and Settings\ofomaiu\Desktop\PP database.mdb"
    Set dbs = OpenDatabase(Path)

    ' SQL statement- Change Query parameters here
    strSQL = "SELECT [Access Compatible].*" & _
    " FROM [Access Compatible]" & _
    " WHERE ((([Access Compatible].[Firing Lot No#])=80554) AND (([Access Compatible].[Run No#])='21'));"

    Set rs = dbs.OpenRecordset(strSQL)
    Set Ws = ActiveSheet

    'Clear cells first
    Cells.Select
    Selection.ClearContents

    For i = 0 To rs.Fields.Count - 1
    Ws.Cells(1, i + 1) = rs.Fields(i).Name

    'Export data from the recordset to a worksheet (Sheet1).
    Ws.Range("A2").CopyFromRecordset rs

    Next

    'Auto-fit columns
    Sheets("Raw Data").Select
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Columns.AutoFit
    Range("A1").Select

    '' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    lbTidy:
    dbs.Close

    Set dbs = Nothing
    Set rs = Nothing

    Exit Sub
    '' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    ErrorHandler:

    vtMessage = "Table and data creation error"
    vtMessage = vtMessage & _
    Chr(10) & _
    Chr(10) & "Error Number: " & Err & _
    Chr(10) & "Error Description: " & Error()

    MsgBox vtMessage, strSQL, vbInformation, ctByg
    Resume lbTidy
    End Sub

  2. #2
    Join Date
    Jul 2003
    Location
    Michigan
    Posts
    1,941
    The first thing I'd look at (by stepping through the code) is if the recordset
    contains the "right" number of records. (I suspect it does)

    I'd then guess it was something to do with the number of rows currently selected by your CELLS.SELECT statement is a different number than the rows returned in the recordset. Before doing your CopyFromRecordset, try putting in a "WS.Range("A2").Select" on the line before.
    Inspiration Through Fermentation

  3. #3
    Join Date
    Apr 2008
    Posts
    6
    Hmm the code is a bit messy and one thing that immediatley jumps out is the the copyfromrecordset method is within your for loop for copying across your field names.

    Have a try with this code

    Code:
    Sub RawLotInput()
    
    Dim dbs As Database
    Dim rs As Recordset
    Dim Ws As Worksheet
    dim wb as workbook
    Dim Path As String
    Dim strSQL As String
    
    On Error GoTo ErrorHandler
    
    ThisWorkbook.Activate
    '' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    ''Open the database
    
    Path = "C:\Documents and Settings\ofomaiu\Desktop\PP database.mdb" 
    Set dbs = workspaces(0).OpenDatabase(Path)
    
    ' SQL statement- Change Query parameters here
    strSQL = "SELECT [Access Compatible].*" & _
    " FROM [Access Compatible]" & _
    " WHERE ((([Access Compatible].[Firing Lot No#])=80554) AND (([Access Compatible].[Run No#])='21'));"
    
    Set rs = dbs.OpenRecordset(strSQL)
    set wb = thisworkbook
    
    wb.worksheets("Raw Data").delete
    
    'dont use set ws = activesheet as when you have a few 
    'copies of excel open at the same time weird things can happen
    
    set ws = wb.worksheets.add
    
    ws.name = "Raw Data"
    
    'Clear cells first
    'Cells.Select
    'Selection.ClearContents
    'you dont need this if you delete the sheet
    'I would recommend deleting the sheet rather than clearing cells
    
    'removed copyfromrecordset from your loop
    For i = 0 To rs.Fields.Count - 1
    Ws.Cells(1, i + 1) = rs.Fields(i).Name
    Next
    
    'Export data from the recordset to a worksheet (Sheet1).
    Ws.Range("A2").CopyFromRecordset rs
    
    
    'Auto-fit columns
    'Select statements are usually unnecessary and where
    'you have select followed selection you can combine this
    
    ws.Range("A1").CurrentRegion.Columns.AutoFit
    
    
    '' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    lbTidy:
    dbs.Close
    
    Set dbs = Nothing
    Set rs = Nothing
    
    Exit Sub
    '' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    ErrorHandler:
    
    vtMessage = "Table and data creation error"
    vtMessage = vtMessage & _
    Chr(10) & _
    Chr(10) & "Error Number: " & Err & _
    Chr(10) & "Error Description: " & Error()
    
    MsgBox vtMessage, strSQL, vbInformation, ctByg
    Resume lbTidy
    End Sub

  4. #4
    Join Date
    May 2008
    Posts
    9

    tried the new code

    Thanks for the code. I tried it out and now it is pulling just the field names into row 1 of the "raw data" sheet. It is not pulling the records. And this is the new error:

    "Table and data creation error
    Error Number: -2147467259
    Error Description: Method 'CopyFromRecordset' of object 'Range' failed"

    For some reason, it is not able to transfer the records from 'rs' to the worksheet. Any help will be appreciated.

    Thanks.

  5. #5
    Join Date
    Apr 2008
    Posts
    6
    Are you sure there are records in your recordset? Use debug.print rs.recordcount to make sure you have more than 0 records and less than 65535 records.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •