-1 returned as last record of recordset object

Giganews Newsgroups
Subject: -1 returned as last record of recordset object
Posted by:  Anthony (donotreply@nospam.com)
Date: Tue, 11 May 2004

Hey All,

I'm using a DAO.recordset object to retrieve info from an access DB, and
when I transpose the records onto my Excel workbook, the final record ends
up with the "absolute position" indicator of -1, hence, when i try to
extract any data from said record, I get a "Run Time Error 1004: No Current
Record".  I've never used "application.transpose" before, but short of going
column by column, I couldn't find any other way to copy/paste the data one
record at a time.  There are too many columns in each record to do it
column-by-column.

In case it helps, here's the code I'm using--I'm basically doing a query and
then running a subquery based on one piece of criteria from each row of the
initial query (if that all made sense).  The really strange thing is that
the 2nd query, which is supposed to be based on 1 column ("Val1") from each
row of the 1st query actually shows up *before* the data from the first
query on the worksheet.  I'm at a loss.

Things commented out were failed troubleshooting attempts.

Code:
Sub compileData2()
Dim db1 As DAO.Database
Dim rs1 As DAO.Recordset
Dim strSQL1 As String
Dim rs2 As DAO.Recordset
Dim strSQL2 As String
Dim strCircNum As String
Dim strPath As String
Dim strRow As String
Dim array1 As Variant
Dim array2 As Variant
Dim x As Long
Dim y As Long
Dim z As Long

'Select the source database path from the Interface worksheet
Sheets("Interface").Select
strPath = Range("B3").Value

'Assign Path to db1
Set db1 = OpenDatabase(strPath, , True)

strSQL1 = "SELECT * FROM qryNumber1"
Set rs1 = db1.OpenRecordset(strSQL1, dbOpenSnapshot, dbReadOnly, dbReadOnly)

If rs1.EOF And rs1.BOF Then
    Exit Sub
End If

rs1.MoveLast
MsgBox rs1.RecordCount, vbOKOnly

'Clear data on current worksheet
With Worksheets("testsheet")
    .Rows("5:65536").Delete
End With

'Value in Frame/T1 Array
x = 1

'Current Row in Destination worksheet
y = 5

rs1.MoveFirst
Do While Not rs1.EOF
    'Debug.Print rs1("CircuitID").Value & vbCrLf
    array1 = rs1.GetRows

    'Copy headers
    Sheets("Interface").Select
    Rows("32:32").Select
    Selection.Copy

    'Paste headers
    Sheets("Testsheet").Select
    Rows(y).Select
    ActiveSheet.Paste

    y = y + 1

    With Worksheets("testsheet")
        .Range("A" & y & ":Z" & y).Value = Application.Transpose(array1)
        '.Select
        'y = y + 1
        '.Range("A" & y & ":A" & y).Value = rs1.AbsolutePosition
        '.Range("B" & y & ":B" & y).Value = rs1("Val1")
    End With

    If IsNull(rs1("Val1").Value) = False Then
        strCircNum = rs1("Val1").Value

        strSQL2 = "SELECT * FROM qryNumber2 WHERE Val1 in ('" & strCircNum &
"')"
        Set rs2 = db1.OpenRecordset(strSQL2, dbOpenSnapshot, dbReadOnly,
dbReadOnly)

        If rs2.BOF And rs2.EOF Then
            'MsgBox "No records were returned.", vbOKOnly
            GoTo NoCircDetail
        Else
            y = y + 1
            z = 1
            rs2.MoveFirst
            Do While Not rs2.EOF
                strRow = rs2(2).Value & " " & rs2(1).Value & " " &
rs2(3).Value & " " & rs2(4).Value
                array2 = rs2.GetRows(z)
                    With Worksheets("testsheet")
                        .Range("B" & y & ":F" & y).Value =
Application.Transpose(array2)
                        '.Select
                    End With
                'Debug.Print strRow
                'rs2.MoveNext
                y = y + 1
            Loop
            'End With
        End If
    End If

NoCircDetail:
'        rs1.MoveNext
        'x = x + 1
        y = y + 1
Loop

ExitProcess:
    rs1.Close
    rs2.Close
    Set rs1 = Nothing
    Set rs2 = Nothing
    Set db1 = Nothing
    Exit Sub

End Sub

Replies