Openrecordset Query NOT Working! (1 Viewer)

themanof83

Registered User.
Local time
Today, 16:30
Joined
May 1, 2008
Messages
73
Evening All!

I am familiar with the DAO Openrecordset function when using tables. I know that the following code works when using a table but I would like to use it using a query I have saved away; as follows:

Code:
Set MYDB = CurrentDb()
Set TARGET = MYDB.OpenRecordset(stQuery)
TARGET.MoveFirst
 
Do While Not TARGET.EOF
 
        If IsNull(TARGET.Fields("Document Folder")) Then
            MsgBox "There is no associated folder supplied with the test: " & TARGET.Fields("Test") & _
                   "Test " & TARGET.Fields("Test") & "will not be included in batch file!", vbInformation + vbOKOnly, _
                   "No folder supplied"
        Else
 
            If TARGET.Fields("Main") = -1 Then
 
                PDFHyper = d.Column(2) & d.Column(3) & "\test\autotest\QTG\" & _
                d.Column(5) & "\" & TARGET.Fields("Test")
 
            End If
 
            If TARGET.Fields("Generic") = -1 Then
 
                PDFHyper = d.Column(2) & d.Column(3) & "\test\autotest\QTG\" & _
                d.Column(6) & "\" & TARGET.Fields("Test")
 
            End If
 
            If TARGET.Fields("Visual") = -1 Then
 
                PDFHyper = d.Column(2) & d.Column(3) & "\test\autotest\QTG\" & _
                d.Column(7) & "\" & TARGET.Fields("Test")
 
            End If
            MyFile = d.Column(2) & d.Column(3) & "\test\AUTOTEST\batch\" & stBatchName
            Debug.Print MyFile
                'Open File if not already opened
                If Not FileLocked(MyFile) Then
                    'File Number = current iteration
                    fnum = FreeFile()
                    'Open File
                    Open MyFile For Append As fnum
                    'Print to File
                    Print #fnum, PDFHyper
                Else
                    'Print to File
                    Print #fnum, PDFHyper
                End If
        Close #fnum
        TARGET.MoveNext
        End If
Loop
'Close Query
TARGET.Close

I've seen alot of posts about the unsuccesful use of Openrecordset when using Queries but haven't come accross too many work arounds...
Any help on getting this to work for pre-defined queries (as opposed to SQL statements) would be very gratefully recieved...

I am at the end of my patience with this one!!

Cheers,
 

vbaInet

AWF VIP
Local time
Today, 16:30
Joined
Jan 22, 2010
Messages
26,374
Whether it's a table name or a query name or a Select statement the OpenRecordset method can open any one of them.

What error are you getting?
 

themanof83

Registered User.
Local time
Today, 16:30
Joined
May 1, 2008
Messages
73
That's exsactly what I thought!
I'm not getting any error messages, it's just not running through the Do Loop when I have a query name in the OpenRecordset function.
If I put a table name in there then it's fine.....?! :confused:
 

vbaInet

AWF VIP
Local time
Today, 16:30
Joined
Jan 22, 2010
Messages
26,374
Have you stepped through your code? Put a msgbox just after the Do While statement to see if (and how many times) it gets fired.

Plus if stquery is the name of the query then it must be enclosed in quotes.
 

themanof83

Registered User.
Local time
Today, 16:30
Joined
May 1, 2008
Messages
73
Yes, there's debug code in the loop already and it is definately working when I use a table instead...

stQuery is a well defined String ....
 

boblarson

Smeghead
Local time
Today, 08:30
Joined
Jan 12, 2001
Messages
32,059
stQuery is a well defined String ....
Since we can't see that, we can't make that determination. Post the whole thing so we can see what stQuery contains.

Also, is stQuery just a name of a saved query? If so, what is the SQL for that saved query? Does it have criteria based on form fields? If so, that might be your problem.
 

vbaInet

AWF VIP
Local time
Today, 16:30
Joined
Jan 22, 2010
Messages
26,374
Well, I don't get your point here. You say the recordset you are opening is a query however, you're opening something contained in the sqQuery string? Which is?
 

themanof83

Registered User.
Local time
Today, 16:30
Joined
May 1, 2008
Messages
73
Good questions Bob...

Here's the full code:

Code:
Private Sub CreateBatch_Click()
'This Subroutine outputs a number of batch files for the currently selected query
'in the default directory [URL="file://\\proj\test\autotest\batch"]\\proj\test\autotest\batch[/URL]
Dim d As Control
Dim FileOpen As Boolean
Dim MyFile As String
Dim Section As String
Dim PDFHyper As String
Dim TESTHyper As String
Dim Folder
Dim stQuery As String
Dim stBatchName As String
Dim stDate As String
Dim COUNT, i As Integer
Dim QDF As DAO.QueryDef
Dim MYDB As DAO.Database
Dim TARGET As DAO.Recordset
On Error GoTo Err_CreateBatch_Click
Set d = [Forms]![Select Programme]![SelectProg]
Set MYDB = Nothing
stQuery = ""
stBatchName = ""
stDate = Format(Date, "dmmmyy")
'stDate = Replace(Date, "/", "")
Debug.Print stDate
        
    Select Case Me!SelectStatus
        Case 1
            stQuery = "QTG Tests Complete"
            stBatchName = "QTG_Tests_Complete" & "_" & stDate
        Case 2
            stQuery = "QTG Tests In Tolerance"
            stBatchName = "QTG_Tests_In_Tolerance" & "_" & stDate
        Case 3
            stQuery = "QTG Tests In Progress"
            stBatchName = "QTG_Tests_In_Progress" & "_" & stDate
        Case 4
            stQuery = "QTG Tests Re-test Required"
            stBatchName = "QTG_Tests_Re-Testing" & "_" & stDate
        Case 5
            stQuery = "QTG Tests Not Yet Tested"
            stBatchName = "QTG_Tests_Not_Yet_Tested" & "_" & stDate
        Case 6
            'Me.CreateBatch.Enabled = False
            'stQuery = "QTG Test Status"
            'stBatchName = "QTG_Test_Status" & Me.QTGTest & "_" & stDate
    End Select
             
    Select Case Me!SelectSearch
        Case 1
            If IsNull(Me.SelectSection.Column(1)) Then
                MsgBox "Please select a Section!", vbInformation + vbOKOnly, _
                        "Select Section"
                End
            Else
                stQuery = "QTG Tests By Section"
                stBatchName = "QTG_Section_" & Me.SelectSection.Column(1) & "_" & stDate
            End If
        Case 2
            If Me.SelectVolume = 1 Then
                MsgBox "Volume 1 is reserved for the Front Document." & vbCrLf & _
                "Please select an appropriate Volume.", vbInformation + vbOKOnly, _
                        "Select Appropriate Volume"
                End
            End If
                        
            If IsNull(Me.SelectVolume) Then
                MsgBox "Please select a Volume!", vbInformation + vbOKOnly, _
                        "Select Volume"
                End
            Else
                stQuery = "QTG Tests By Volume"
                stBatchName = "QTG_Volume_" & Me.SelectVolume & "_" & stDate
            End If
        Case 3
            If IsNull(Me.SelectData) Then
                MsgBox "Please select a Data Type!", vbInformation + vbOKOnly, _
                        "Select Data Type"
                End
            Else
                stQuery = "QTG Tests By Data Type"
                stBatchName = "QTG_Data_Type_" & Me.SelectData & "_" & stDate
            End If
        Case 4
            If IsNull(Me.SelectLoad) Then
                MsgBox "Please select a Load!", vbInformation + vbOKOnly, _
                        "Select Load"
                End
            Else
                stQuery = "QTG Tests By Load"
                stBatchName = "QTG_Load_" & Me.SelectLoad & "_" & stDate
            End If
        Case 5
            If IsNull(Me.SelectFolder.Column(1)) Then
                MsgBox "Please select an exisiting Folder!", vbInformation + vbOKOnly, _
                        "Select Folder"
                End
            Else
                stQuery = "QTG Tests By Folder"
                stBatchName = "QTG_Folder_" & Me.SelectFolder.Column(3) & "_" & stDate
            End If
        Case 6
            If IsNull(Me.SelectProgramme.Column(1)) Then
                MsgBox "Please select a Programme!", vbInformation + vbOKOnly, _
                        "Select Programme"
                End
            Else
                stQuery = "QTG Tests By Programme"
                stBatchName = "QTG_Programme_" & Me.SelectProgramme.Column(1) & "_" & stDate
            End If
            
    End Select
    
        
If (IsNull(Me!SelectSearch) And IsNull(Me!SelectStatus)) Then
    MsgBox "No filter or query has been selected!" & vbCrLf & "Please make a selection from the given options.", vbExclamation + vbOKOnly, _
           "No Selection Made"
           
    Exit Sub
End If
If (Me!SelectStatus.Value = 6) Then
    MsgBox "Batch files cannot be created for single QTG tests!" & vbCrLf & "Please make another selection from the given options.", vbExclamation + vbOKOnly, _
           "Unable to Create Batch File"
           
    Exit Sub
End If
       
Debug.Print stQuery
Debug.Print stBatchName
Set MYDB = CurrentDb()
Set TARGET = MYDB.OpenRecordset(stQuery)
'COUNT = DCount("Test", "QTG Tests")
'Debug.Print COUNT
TARGET.MoveFirst
Do While Not TARGET.EOF
        
        If IsNull(TARGET.Fields("Document Folder")) Then
            MsgBox "There is no associated folder supplied with the test: " & TARGET.Fields("Test") & _
                   "Test " & TARGET.Fields("Test") & "will not be included in batch file!", vbInformation + vbOKOnly, _
                   "No folder supplied"
        Else
                        
            If TARGET.Fields("Main") = -1 Then
        
                PDFHyper = d.Column(2) & d.Column(3) & "\test\autotest\QTG\" & _
                d.Column(5) & "\" & TARGET.Fields("Test")
    
            End If
    
            If TARGET.Fields("Generic") = -1 Then
            
                PDFHyper = d.Column(2) & d.Column(3) & "\test\autotest\QTG\" & _
                d.Column(6) & "\" & TARGET.Fields("Test")
    
            End If
            
            If TARGET.Fields("Visual") = -1 Then
    
                PDFHyper = d.Column(2) & d.Column(3) & "\test\autotest\QTG\" & _
                d.Column(7) & "\" & TARGET.Fields("Test")
        
            End If
            MyFile = d.Column(2) & d.Column(3) & "\test\AUTOTEST\batch\" & stBatchName
            Debug.Print MyFile
                'Open File if not already opened
                If Not FileLocked(MyFile) Then
                    'File Number = current iteration
                    fnum = FreeFile()
                    'Open File
                    Open MyFile For Append As fnum
                    'Print to File
                    Print #fnum, PDFHyper
                Else
                    'Print to File
                    Print #fnum, PDFHyper
                End If
        Close #fnum
        End If
        
        TARGET.MoveNext
        
Loop
'Close Query
TARGET.Close

Exit_CreateBatch_Click:
    Exit Sub
    
Err_CreateBatch_Click:
    Resume Exit_CreateBatch_Click
End Sub

The Queries that are being called do infact have criteria determined from Forms, however, all these Forms are open so the data is available.

Cheers
 

boblarson

Smeghead
Local time
Today, 08:30
Joined
Jan 12, 2001
Messages
32,059
The Queries that are being called do infact have criteria determined from Forms, however, all these Forms are open so the data is available.
Just because the form is open doesn't mean that you aren't going to have problems. You most likely will need to either set up the queries to explicitly state the parameters or use a querydef to pass the values of the form controls to the query at runtime. It is not too intuitive but just having the query reference the form controls doesn't work manytimes when you are trying to open a recordset based on that query.
 

themanof83

Registered User.
Local time
Today, 16:30
Joined
May 1, 2008
Messages
73
I appreciate that Bob thanks...

Any chance you can explain the QueryDef route for me, something I'm not familiar with.

Cheers.
 

themanof83

Registered User.
Local time
Today, 16:30
Joined
May 1, 2008
Messages
73
Thank you all so much, you are all heroes! I haven't used this forum in over a year but once again my questions are answered!

Cheers guys, here's the final code:

Code:
Private Sub CreateBatch_Click()
'This Subroutine outputs a number of batch files for the currently selected query
'in the default directory [URL="file://\\proj\test\autotest\batch"]\\proj\test\autotest\batch[/URL]
Dim d As Control
Dim FileOpen As Boolean
Dim MyFile As String
Dim Section As String
Dim PDFHyper As String
Dim TESTHyper As String
Dim Folder
Dim stQuery As String
Dim stBatchName As String
Dim stDate As String
Dim COUNT, i As Integer
Dim QDF As DAO.QueryDef
Dim MYDB As DAO.Database
'Dim TARGET As DAO.Recordset
Dim CMD As New ADODB.Command
Dim PRM As ADODB.Parameter
Dim TARGET As New ADODB.Recordset
On Error GoTo Err_CreateBatch_Click
Set d = [Forms]![Select Programme]![SelectProg]
Set MYDB = Nothing
stQuery = ""
stBatchName = ""
stDate = Format(Date, "dmmmyy")
'stDate = Replace(Date, "/", "")
Debug.Print stDate
        
    Select Case Me!SelectStatus
        Case 1
            stQuery = "QTG Tests Complete"
            stBatchName = "QTG_Tests_Complete_" & stDate
        Case 2
            stQuery = "QTG Tests In Tolerance"
            stBatchName = "QTG_Tests_In_Tolerance_" & stDate
        Case 3
            stQuery = "QTG Tests In Progress"
            stBatchName = "QTG_Tests_In_Progress_" & stDate
        Case 4
            stQuery = "QTG Tests Re-test Required"
            stBatchName = "QTG_Tests_Re-Testing_" & stDate
        Case 5
            stQuery = "QTG Tests Not Yet Tested"
            stBatchName = "QTG_Tests_Not_Yet_Tested_" & stDate
        Case 6
            'Me.CreateBatch.Enabled = False
            'stQuery = "QTG Test Status"
            'stBatchName = "QTG_Test_Status" & Me.QTGTest & "_" & stDate
    End Select
             
    Select Case Me!SelectSearch
        Case 1
            If IsNull(Me.SelectSection.Column(1)) Then
                MsgBox "Please select a Section!", vbInformation + vbOKOnly, _
                        "Select Section"
                End
            Else
                stQuery = "QTG Tests By Section"
                stBatchName = "QTG_Section_" & Me.SelectSection.Column(1) & "_" & stDate
            End If
        Case 2
            If Me.SelectVolume = 1 Then
                MsgBox "Volume 1 is reserved for the Front Document." & vbCrLf & _
                "Please select an appropriate Volume.", vbInformation + vbOKOnly, _
                        "Select Appropriate Volume"
                End
            End If
                        
            If IsNull(Me.SelectVolume) Then
                MsgBox "Please select a Volume!", vbInformation + vbOKOnly, _
                        "Select Volume"
                End
            Else
                stQuery = "QTG Tests By Volume"
                stBatchName = "QTG_Volume_" & Me.SelectVolume & "_" & stDate
            End If
        Case 3
            If IsNull(Me.SelectData) Then
                MsgBox "Please select a Data Type!", vbInformation + vbOKOnly, _
                        "Select Data Type"
                End
            Else
                stQuery = "QTG Tests By Data Type"
                stBatchName = "QTG_Data_Type_" & Me.SelectData & "_" & stDate
            End If
        Case 4
            If IsNull(Me.SelectLoad) Then
                MsgBox "Please select a Load!", vbInformation + vbOKOnly, _
                        "Select Load"
                End
            Else
                stQuery = "QTG Tests By Load"
                stBatchName = "QTG_Load_" & Me.SelectLoad & "_" & stDate
            End If
        Case 5
            If IsNull(Me.SelectFolder.Column(0)) Then
                MsgBox "Please select an exisiting Folder!", vbInformation + vbOKOnly, _
                        "Select Folder"
                End
            Else
                stQuery = "QTG Tests By Folder"
                stBatchName = "QTG_Folder_" & Me.SelectFolder.Column(0) & "_" & stDate
            End If
        Case 6
            If IsNull(Me.SelectProgramme.Column(1)) Then
                MsgBox "Please select a Programme!", vbInformation + vbOKOnly, _
                        "Select Programme"
                End
            Else
                stQuery = "QTG Tests By Programme"
                stBatchName = "QTG_Programme_" & Me.SelectProgramme.Column(1) & "_" & stDate
            End If
            
    End Select
    
        
If (IsNull(Me!SelectSearch) And IsNull(Me!SelectStatus)) Then
    MsgBox "No filter or query has been selected!" & vbCrLf & "Please make a selection from the given options.", vbExclamation + vbOKOnly, _
           "No Selection Made"
           
    Exit Sub
End If
If (Me!SelectStatus.Value = 6) Then
    MsgBox "Batch files cannot be created for single QTG tests!" & vbCrLf & "Please make another selection from the given options.", vbExclamation + vbOKOnly, _
           "Unable to Create Batch File"
           
    Exit Sub
End If
       
Debug.Print stQuery
Debug.Print stBatchName

Set CMD.ActiveConnection = CurrentProject.Connection
CMD.CommandText = "SELECT * FROM [" & stQuery & "]"
CMD.Parameters.Refresh
For Each PRM In CMD.Parameters
    PRM.Value = Eval(PRM.Name)
Next
TARGET.Open CMD, , adOpenKeyset
TARGET.MoveFirst
Do While Not TARGET.EOF
        
        If IsNull(TARGET.Fields("Document Folder")) Then
            MsgBox "There is no associated folder supplied with the test: " & TARGET.Fields("Test") & _
                   "Test " & TARGET.Fields("Test") & "will not be included in batch file!", vbInformation + vbOKOnly, _
                   "No folder supplied"
        Else
                        
            If TARGET.Fields("Main") = -1 Then
        
                PDFHyper = d.Column(2) & d.Column(3) & "\test\autotest\QTG\" & _
                d.Column(5) & "\" & TARGET.Fields("Test")
    
            End If
    
            If TARGET.Fields("Generic") = -1 Then
            
                PDFHyper = d.Column(2) & d.Column(3) & "\test\autotest\QTG\" & _
                d.Column(6) & "\" & TARGET.Fields("Test")
    
            End If
            
            If TARGET.Fields("Visual") = -1 Then
    
                PDFHyper = d.Column(2) & d.Column(3) & "\test\autotest\QTG\" & _
                d.Column(7) & "\" & TARGET.Fields("Test")
        
            End If
            MyFile = d.Column(2) & d.Column(3) & "\test\AUTOTEST\batch\" & stBatchName
            Debug.Print MyFile
                'Open File if not already opened
                If Not FileLocked(MyFile) Then
                    'File Number = current iteration
                    fnum = FreeFile()
                    'Open File
                    Open MyFile For Append As fnum
                    'Print to File
                    Print #fnum, PDFHyper
                Else
                    'Print to File
                    Print #fnum, PDFHyper
                End If
        Close #fnum
        End If
        
        TARGET.MoveNext
        
Loop
'Close Query
TARGET.Close

Exit_CreateBatch_Click:
    Exit Sub
    
Err_CreateBatch_Click:
    Resume Exit_CreateBatch_Click
End Sub
 

LPurvis

AWF VIP
Local time
Today, 16:30
Joined
Jun 16, 2008
Messages
1,269
There really wasn't any need to move away from DAO to ADO.
The same technique works on both - as I described.
 

themanof83

Registered User.
Local time
Today, 16:30
Joined
May 1, 2008
Messages
73
Leigh,

I tried the DAO methods listed here but they didn't seem to do the job...
I implimented the code from your original post that you linked to... which was ADO, was it not???

Personally not a huge VBA programmer so not involved with the ADO/DAO conflict ;)....
 

LPurvis

AWF VIP
Local time
Today, 16:30
Joined
Jun 16, 2008
Messages
1,269
Well yes the first snippet was ADO in response to the question at hand.
But I was pointing you to the fDAOGenericRst function (as a replacement for your OpenRecordset).
I should have been more explicit. Sorry about that.
 

Users who are viewing this thread

Top Bottom