[Processdatech]

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

[RedNeckGeek]

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.

[chergh]

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

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 

[Processdatech]

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.

[chergh]

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.