Access acting as if query is not present, just after telling me it is (1 Viewer)

Alc

Registered User.
Local time
Today, 08:27
Joined
Mar 23, 2007
Messages
2,407
Thanks for the feedback.
Difficult to be sure when lengthy and nested code can't be tested, but here's what doesn't look right to ,me.
If this is false: If QueryExists(strSheetNameNew) Then
go here: GoTo Replace_Query
which says do this: Delete_Query (strSheetNameNew)

If it doesn't exist, how can you delete it?
I was trying to get something to happen. Each time the code fails, I can see that the query does exist so I was experimenting to find out what would happen if it tried to delete it again.
Also, I question your placement of RstExport.MoveNext - you will only move if above is TRUE. If not, you are looping while on the same record.
The one was a mistake. The move next used to be outside the if statement but I moved it when I added debugging. I'd have realized my screw up if the damn thing wasn't failing before hitting that part, as I'd only get one file produced.

As far as the GoTo thing is concerned, I rarely use it but though it was the easiest way to accomplish my test.

@Alc - suggest you research and apply debug.assert to stop the code when about to fail (i.e. before the Debug.Print strSheetNameNew & " does Not Exist" line and thoroughly check all the variables and step through the code at that point.

just in case it is actually the speed of operation causing the issue I would add further doevents between each line of code and see if that resolves the issue

then repeat same query, same data enough times to be sure the problem is solved.
Will work through this, this morning. It's causing problems, so has become my top priority and I don't have to worry about getting sidetracked.

Thanks again.
 

Alc

Registered User.
Local time
Today, 08:27
Joined
Mar 23, 2007
Messages
2,407
Finally, it appears to be working.

The solution was to add a short delay (using a new sub procedure) in between the part that creates the query and refreshes the database and the part that checks if the query exists before exporting its contents. Changes shown in red.

I tried with a long pause of 10 seconds first, just to see if that worked. Once it did, I cut it down by increments until I got to the lowest value that produced no errors when tested on any of the PCs that might need to run the procedure. Just to be safe, I then added one second.

Thanks to all for your help.


Code:
Public Function Export_Data(strNewBook As String, strSheetName As String, Db As Database, strSQLToRun As String)
    Dim QdfNew As QueryDef
    Dim xlSheetToFormat As Object
    Dim RstExport As Recordset
    Dim strNewSQL As String
    Dim strSheetNameBase As String
    Dim strSheetNameNew As String
    Dim strPrefix As String
    Dim strPartNo As String
    Dim strYear As String
    
    ' this is the collection
    Dim Coll As New Collection
    
    On Error GoTo Err_Point

    strSheetNameBase = strSheetName

    Set RstExport = Db.OpenRecordset(strSQLToRun)
    If RstExport.RecordCount <> 0 Then
        RstExport.MoveFirst
        Do While Not RstExport.EOF
            strNewSQL = Db.QueryDefs("qryexceedancemgmt(MV)_MultiExport2").SQL
            
            strPrefix = Left(RstExport![DataTable], Len(RstExport![DataTable]) - 1)
            strYear = Right(RstExport![DataTable], 1)
            strPartNo = RstExport![Part#]
            
            strNewSQL = Replace(strNewSQL, "AAAAA", strPrefix)
            strNewSQL = Replace(strNewSQL, "BBBBB", strYear)
            strNewSQL = Replace(strNewSQL, "CCCCC", strPartNo)

            strSheetNameNew = strSheetNameBase & "_" & strPartNo & "_" & strPrefix & strYear

Replace_Query:

            Delete_Query (strSheetNameNew)

            Set QdfNew = Db.CreateQueryDef(strSheetNameNew, strNewSQL)
            Db.QueryDefs.Refresh

            Application.RefreshDatabaseWindow
            
[COLOR="Red"][B]            WaitFor (3)[/B][/COLOR]
            
            If QueryExists(strSheetNameNew) Then
                'Debug.Print strSheetNameNew & " exists"

                ' add the query name to collection object
                Coll.Add strSheetNameNew

                DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, strSheetNameNew, strNewBook, True
                                
                Set QdfNew = Nothing
                             
            Else
                Debug.Print strSheetNameNew & " does Not Exist"
                
                GoTo Replace_Query
            End If
            
            RstExport.MoveNext

        Loop
    End If
    
Exit_Point:
    ' delete the queries made
    Dim i As Integer
    For i = 1 To Coll.Count
        CurrentDb.QueryDefs.Delete Coll.Item(i)
    Next
    Set Coll = Nothing
    
    Exit Function
    
Err_Point:
    
    strResponse = MsgBox(Err.Number & Chr(13) & Err.DESCRIPTION, vbCritical, "Error")
    Resume Exit_Point
End Function

[B][COLOR="red"]Sub WaitFor(NumOfSeconds As Long)
    Dim SngSec As Long
    
    SngSec = Timer + NumOfSeconds
    
    Do While Timer < SngSec
    DoEvents
    Loop
End Sub[/COLOR][/B]
 

Users who are viewing this thread

Top Bottom