Fixing run-time error 3049

[kthakk4]

I have some code that was working fine, but recently I started getting VBA Runtime Error 3049 - The error message indicates: "Cannot open database ''. It may not be a database that your application recognizes, or the file may be corrupt."

Following is the code for function:

Function MakeListingTable()
Dim db As DAO.Database, rs As DAO.Recordset, runcode As String, qd As DAO.QueryDef
Set db = CurrentDb
DoEvents
runcode = Wait(3, 1)
Set rs = db.OpenRecordset("Y_Distinct_Levels")
While Not rs.EOF
Select Case rs("LEVEL_ID_TYPE")
Case "terr"
'Append in terr and account
Set qd = db.QueryDefs("Y03_Append_Y_Final_Listing")
qd("Load_Report_Name") = rs("Report_Name")
qd("Load_nat") = "*"


qd("Load_reg") = "*"
qd("Load_dist") = "*"
qd("Load_terr") = rs("level_id")
qd.Execute dbFailOnError

Case "dist"
'Append in dist, terr and account
Set qd = db.QueryDefs("Y03_Append_Y_Final_Listing")
qd("Load_Report_Name") = rs("Report_Name")
qd("Load_nat") = "*"
qd("Load_reg") = "*"
qd("Load_dist") = rs("level_id")
qd("Load_terr") = "*"
qd.Execute dbFailOnError

Case "reg"
'Append in reg, dist, terr and account
Set qd = db.QueryDefs("Y03_Append_Y_Final_Listing")
qd("Load_Report_Name") = rs("Report_Name")
qd("Load_nat") = "*"
qd("Load_reg") = rs("level_id")
qd("Load_dist") = "*"
qd("Load_terr") = "*"
qd.Execute dbFailOnError

Case "nat"
'Append in nat, reg, dist, terr and account
Set qd = db.QueryDefs("Y03_Append_Y_Final_Listing")
qd("Load_Report_Name") = rs("Report_Name")
qd("Load_nat") = rs("level_id")
qd("Load_reg") = "*"
qd("Load_dist") = "*"
qd("Load_terr") = "*"
qd.Execute dbFailOnError

End Select
rs.MoveNext
Wend
End Function


Here "Y03_Append_Y_Final_Listing is a query that updates a table. The debugger for this error appears on the red colored text in code.

I have already used the compact and repair tool on the database. Additionally, I have exported contents of the database into a new blank access file in order to rule out data corruption.

What I find weird is that this error happens only on some occasions and seem to be related to the number or records being appended.

[ajetrumpet]

I've never used this method that you're using. however, are you sure the prob is the num of recs being appended? does it break on any other case?

one 'technical' thing to fix is to put your decs on single lines only:

Dim db As DAO.Database
dim rs As DAO.Recordset, runcode As String
dim qd As DAO.QueryDef

believe it or not, I've seen this cause problems, and I believe the last problem I saw was with the currentdb!

the other thing to consider here is that you're requesting a lot of memory usage from access by doing this. this is asking the engine to do a lot of work very quickly (assuming some requests are using high amounts of recs)