Openrecordset Query NOT Working!

T

themanof83

Registered User.
Local time
Today, 11:42
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,
 
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?
 
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:
 
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.
 
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 ....
 
themanof83 said:
stQuery is a well defined String ....
Click to expand...
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.
 
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?
 
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
 
themanof83 said:
The Queries that are being called do infact have criteria determined from Forms, however, all these Forms are open so the data is available.
Click to expand...
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.
 
I appreciate that Bob thanks...

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

Cheers.
 
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
 
There really wasn't any need to move away from DAO to ADO.
The same technique works on both - as I described.
 
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 ;)....
 
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.
 
You must log in or register to reply here.

Similar threads

F
Add query data to existing export function
Replies
1
Views
603
MarkK
MarkK
J
Mapped drive not showing.
Replies
2
Views
324
John Sh
J
N
Code does not support certain characters such as full-width symbols or Chinese
Replies
1
Views
616
ebs17
E
N
Solved Record set too slow with SQL server Cloud & Parameters not working
Replies
15
Views
969
cheekybuddha
cheekybuddha
R
Closing all MDI child forms when Ctrl-F4 not available
Replies
6
Views
386
Pat Hartman
P

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom