Use Query As DAO.Recordset

1.8k Views Asked by At

I am attempting to iterate a query as a DAO.Recordset, my issue is that my recordset never prints anything. If I look at my table, and my query both of them have the data that I am after, but the VBA is not producing the data that I expect. Below is synatx - why will this not write my data?

Option Compare Database
Sub Test()

Dim query1 As String, rs1 As DAO.Recordset
Dim qryDef As QueryDef, strSQL As String

query1 = "qryPullData"

strSQL = "SELECT fl1 As [Field With Spaces One],fl2 As [Field With Spaces Two], " & _
     "fl3 As [Field WIth Spaces Three], fl4 As [Field With Spaces Four] " & _
     "FROM smallsubset ORDER BY fl1 ASC;"

Set qryDef = CurrentDb.CreateQueryDef(query1, strSQL)


Set rs1 = CurrentDb.OpenRecordset(query1)

If Not rs1.EOF Then
    While Not rs1.EOF
            Debug.Print rs1("Field With Spaces One")
            Debug.Print rs1("Field With Spaces Two")
            Debug.Print rs1("Field With Spaces Three")
            Debug.Print rs1("Field With Spaces Four")
            Debug.Print rs1("[Field With Spaces One]")
            Debug.Print rs1("[Field With Spaces Two]")
            Debug.Print rs1("[Field With Spaces Three]")
            Debug.Print rs1("[Field With Spaces Four]")
    Wend
    rs1.Close
End If
End Sub
2

There are 2 best solutions below

0
On

Here is the code using several of the suggestions from the above comments:

Sub Test()
    Dim query1 As String, rs1 As DAO.Recordset
    Dim qryDef As QueryDef, strSQL As String

    If CheckQuery("qryPullData") = "Yes" Then
        DoCmd.DeleteObject acQuery, "qryPullData"
    End If

    query1 = "qryPullData"

    strSQL = "SELECT fl1 As [Field With Spaces One],fl2 As [Field With Spaces Two], " & _
    "fl3 As [Field WIth Spaces Three], fl4 As [Field With Spaces Four] " & _
    "FROM smallsubset ORDER BY fl1 ASC;"

    Set qryDef = CurrentDb.CreateQueryDef(query1, strSQL)

    Set rs1 = CurrentDb.OpenRecordset(query1)
    rs1.MoveFirst

    While Not rs1.EOF
        Debug.Print rs1("Field With Spaces One")
        Debug.Print rs1("Field With Spaces Two")
        Debug.Print rs1("Field With Spaces Three")
        Debug.Print rs1("Field With Spaces Four")
        rs1.MoveNext
    Wend
    rs1.Close

End Sub

Here is the CheckQuery sub stolen from here: http://www.access-programmers.co.uk/forums/showthread.php?t=206298

Function CheckQuery(queryName As String)
    Dim qryLoop As QueryDef
    Dim dbs As Database
    Dim exists As String

    exists = "No"
    For Each qryLoop In CurrentDb.QueryDefs
        If qryLoop.Name = queryName Then
            exists = "Yes"
            Exit For
        End If
    Next
    CheckQuery = exists
End Function

Make sure that you are looking in the immediate window for the Debug.Print results.

0
On

Slightly tidier version of code from @tlemaster. This will format your output a little better rather than just running all the fields and records together one after the other, removes unnecessary variables from the CheckQuery function and properly releases all the object variables.

Public Sub Test()
    Dim rs1 As DAO.Recordset
    Dim qryDef As QueryDef
    Dim query1 As String
    Dim strSQL As String
    Dim lngRecordNum As Long    '(how many records are you expecting?)

    query1 = "qryPullData"

    If QueryExists(query1) Then
        DoCmd.DeleteObject acQuery, query1
    End If

    strSQL = "SELECT fl1 As [Field With Spaces One], fl2 As [Field With Spaces Two], " & _
    "fl3 As [Field WIth Spaces Three], fl4 As [Field With Spaces Four] " & _
    "FROM smallsubset ORDER BY fl1 ASC;"

    Set qryDef = CurrentDb.CreateQueryDef(query1, strSQL)

    Set rs1 = CurrentDb.OpenRecordset(query1)

    lngRecordNum = 1
    Do While Not rs1.EOF
        Debug.Print "Record " & lngRecordNum & ":"
        Debug.Print "    " & rs1("Field With Spaces One")
        Debug.Print "    " & rs1("Field With Spaces Two")
        Debug.Print "    " & rs1("Field With Spaces Three")
        Debug.Print "    " & rs1("Field With Spaces Four")
        rs1.MoveNext
    Loop

    Set rs1 = Nothing
    Set qryDef = Nothing

End Sub


Public Function QueryExists(queryName As String) As Boolean

    Dim qryLoop As QueryDef

    For Each qryLoop In CurrentDb.QueryDefs
        If qryLoop.Name = queryName Then
            QueryExists = True
            Exit For
        End If
    Next
    Set qryLoop = Nothing

End Function