Run-time error 3011 when repeatedly opening form which exists

[PizMac]

Access 2003. I have a form which constantly loops calling another form (Import_Export) every n minutes (parameterised - set to 5 minutes at the moment) to process files which the user has dumped in a folder. It runs happily for days and then eventually crashes on the form open with the message Run-time error 3011. The Microsoft Jet database engine could not find the object ". Debug shows stdocname contains 'Import_export' and stlinkcriteria is "" so it all LOOKS OK. The code loop is shown below. Any ideas welcome - we have been stuck on this for months and have to quit and restart the application once a week to stop it happening.

Private Sub ImpExp_Click()
On Error GoTo Err_ImpExp_Click
'On Error GoTo 0
Dim t0 As Single
Dim dummy As Integer

Me!RunStop = "RUNNING"
Me.Repaint
PressedStop = False
Do While PressedStop = False
Me!WhereFrom = "ImpExp"
stDocName = "Import_Export"
DoCmd.OpenForm stDocName, , , stLinkCriteria
' the above eventually gives message 3011 could not find the object ""

If Me!ErrorNotFound = True Then
PressedStop = True
Me!RunStop = "STOPPED"
Me!ErrorNotFound = False ' so can retry
Else
t0 = Timer
Do While Timer - t0 < PauseSecs
dummy = DoEvents()
' If we cross midnight, back up one day
If Timer < t0 Then
t0 = Timer
End If
Loop
End If
Loop
Exit_ImpExp_Click:
Exit Sub

Err_ImpExp_Click:
MsgBox Err.Description
Resume Exit_ImpExp_Click
End Sub


Any help very gratefully received Thanks

 

[PHV]

How and where is the form (Import_Export) closed ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[PizMac]

on exit from itself - see below - I've left in a lot of irrelevant code in case it isn't !!(Irrelevant that is)



Private Sub Form_Open(Cancel As Integer)
Set myDB = CurrentDb()

rstStatsOpen = False
rstSuppOpen = False

Set rstTemp = myDB.OpenRecordset("Locations")
myErrorEmail = rstTemp!ErrorEmail
' validate error path
myErrPath = Trim(rstTemp!ErrorPath)
If Right(myErrPath, 1) <> "\" Then myErrPath = myErrPath & "\"
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FolderExists(myErrPath) = False Then
MsgBox "Error File Folder " & myErrPath & " is missing", vbOKOnly, "Disaster-Conversion cancelled"
Forms![mainmenu]!ErrorNotFound = True
GoTo Convert_exit
Else
' folder there
If Forms![mainmenu]!ErrorNotFound = True Then ' was missing before
myMsg = "Error File Folder " & myFpath & " is now available, Conversion resumed"
myMsgType = "Info"
OpErrEmail
Forms![mainmenu]!ErrorNotFound = False
End If
End If

' validate log file
myLogFile = rstTemp!LogFile
myErrorEmail = rstTemp!ErrorEmail
rstTemp.close
Set rstTemp = Nothing

Set fs = CreateObject("Scripting.FileSystemObject")
myTemp = GetFname(myLogFile) ' to get just path
If fs.FolderExists(myFpath) = False Then
If Forms![mainmenu]!LogNotFound = False Then ' 1st time
myMsg = "Log File Folder " & myFpath & " is missing, Conversion cancelled"
myMsgType = "Fatal"
OpErrEmail
Forms![mainmenu]!LogNotFound = True
End If
GoTo Convert_exit
' but come back in later and auto check
Else 'folder there
If Forms![mainmenu]!LogNotFound = True Then ' was missing before
myMsg = "Log File Folder " & myFpath & " is now available, Conversion resumed"
myMsgType = "Info"
OpErrEmail
Forms![mainmenu]!LogNotFound = False
End If
Open myLogFile For Append As #3
End If
' clear last run and set up new one
DoCmd.SetWarnings False
mySQL = "DELETE * FROM LatestStats ;"
DoCmd.RunSQL mySQL
Set rstStats = myDB.OpenRecordset("LatestStats")
rstStatsOpen = True
Set rstSuppliers = myDB.OpenRecordset("SupplierDetails")
rstSuppOpen = True
'loop all SupplierNames in SupplierDetails
rstSuppliers.MoveFirst

Do
' check directories

myIPpath = Trim(rstSuppliers!ImportPath)
If Right(myIPpath, 1) <> "\" Then myIPpath = myIPpath & "\"
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FolderExists(myIPpath) = False Then
If rstSuppliers!ImportNotFound = False Then ' 1st time
myMsg = "Input Folder " & myIPpath & " for " & rstSuppliers!SupplierName & " is missing, Customer ignored"
myMsgType = "Critical"
OpErrEmail
rstSuppliers.Edit
rstSuppliers!ImportNotFound = True
rstSuppliers.Update
End If
GoTo Convert_NextSupplierName
Else ' folder there
If rstSuppliers!ImportNotFound = True Then ' was missing before
myMsg = "InputFolder " & myIPpath & " for " & rstSuppliers!SupplierName & " is now available, Customer conversion resumed"
myMsgType = "Info"
OpErrEmail
rstSuppliers.Edit
rstSuppliers!ImportNotFound = False
rstSuppliers.Update
End If
End If

myOPpath = Trim(rstSuppliers!ExportPath)
If Right(myOPpath, 1) <> "\" Then myOPpath = myOPpath & "\"
If fs.FolderExists(myOPpath) = False Then
If rstSuppliers!ExportNotFound = False Then ' 1st time
myMsg = "Output Folder " & myOPpath & " for " & rstSuppliers!SupplierName & " is missing, Customer ignored"
myMsgType = "Critical"
OpErrEmail
rstSuppliers.Edit
rstSuppliers!ExportNotFound = True
rstSuppliers.Update
End If
GoTo Convert_NextSupplierName
Else ' folder there
If rstSuppliers!ExportNotFound = True Then ' was missing before
myMsg = "Output Folder " & myOPpath & " for " & rstSuppliers!SupplierName & " is now available, Customer conversion resumed"
myMsgType = "Info"
OpErrEmail
rstSuppliers.Edit
rstSuppliers!ExportNotFound = False
rstSuppliers.Update
End If
End If

myARCHpath = Trim(rstSuppliers!ArchivePath)
If Right(myARCHpath, 1) <> "\" Then myARCHpath = myARCHpath & "\"
If fs.FolderExists(myARCHpath) = False Then
If rstSuppliers!ArchiveNotFound = False Then ' 1st time
myMsg = "Output Copy Folder " & myARCHpath & " for " & rstSuppliers!SupplierName & " is missing, Customer ignored"
myMsgType = "Critical"
OpErrEmail
rstSuppliers.Edit
rstSuppliers!ArchiveNotFound = True
rstSuppliers.Update
End If
GoTo Convert_NextSupplierName
Else ' folder there
If rstSuppliers!ArchiveNotFound = True Then ' was missing before
myMsg = "Output Copy Folder " & myARCHpath & " for " & rstSuppliers!SupplierName & " is now available, Customer conversion resumed"
myMsgType = "Info"
OpErrEmail
rstSuppliers.Edit
rstSuppliers!ArchiveNotFound = False
rstSuppliers.Update
End If
End If

' now check template file exists e.g. C:\Argos\EIE\Templates\Evander.xls
If rstSuppliers![MoveFileOnly?] = True Then ' no template
Else
myTemplateFile = Trim(rstSuppliers!HdgsTemplate)
If Right(myTemplateFile, 4) <> ".xls" Then myTemplateFile = myTemplateFile & ".xls"
myTemp = GetFname(myTemplateFile) ' to get just path
myTemplateDodgy = False
If fs.FolderExists(myFpath) = False Then ' dodgy folder
myTemplateDodgy = True
Else
myFFound = Dir(myTemplateFile) ' this given an error at Argos if dodgy folder so tst folder first
If myFFound = "" Then myTemplateDodgy = True
End If
If myTemplateDodgy = True Then
If rstSuppliers!TemplateNotFound = False Then ' 1st time
myMsg = "Headings Template file " & myTemplateFile & " for " & rstSuppliers!SupplierName & " not found, Client ignored-please correct"
myMsgType = "Critical"
OpErrEmail
rstSuppliers.Edit
rstSuppliers!TemplateNotFound = True
rstSuppliers.Update
End If
GoTo Convert_NextSupplierName
Else ' file there
If rstSuppliers!TemplateNotFound = True Then ' was missing before
myMsg = "Headings Template file " & myTemplateFile & " for " & rstSuppliers!SupplierName & " is now available, Customer conversion resumed"
myMsgType = "Info"
OpErrEmail
rstSuppliers.Edit
rstSuppliers!TemplateNotFound = False
rstSuppliers.Update
End If
End If
myTemplateCR = Trim(rstSuppliers!HdgsTemplateCR)
If Len(myTemplateCR) > 0 Then 'optional
' cant be bothered to have another switch for the credit - will just get loads of emails!
If Right(myTemplateCR, 4) <> ".xls" Then myTemplateCR = myTemplateCR & ".xls"
myFFound = Dir(myTemplateCR)
If myFFound = "" Then
myMsg = "Headings Template Credit file " & myTemplateCR & " for " & rstSuppliers!SupplierName & " not found, Client ignored-please correct"
myMsgType = "Critical"
OpErrEmail
GoTo Convert_NextSupplierName
End If
End If
End If
' check directories end
myDateCell = Trim(rstSuppliers!DateCell)
myPrefix = Trim(rstSuppliers!FilePrefix)

'1st - loop all csv files in folder, store in stats
myIpPattern = myIPpath & myPrefix & "*.csv"
myFFound = Dir(myIpPattern, 1) ' include RO files but not sub directories or hidden or system

If myFFound <> "" Then 'some csvs found
myGoodFiles = 0
' check adr there
myTemp = Dir(myIPpath & myPrefix & ".adr", 1)
If myTemp = "" Then ' cant continue
myMsg = rstSuppliers!FilePrefix & ".adr for " & rstSuppliers!SupplierName & " not found, Client ignored-please correct"
myMsgType = "Critical"
OpErrEmail
GoTo Convert_NextSupplierName
Else
myFFound = Dir(myIpPattern, 1) ' find first one again
Do
myGoodFiles = myGoodFiles + 1
myFullFile = myIPpath & myFFound
'strips path and ext, sets myipext
MyJustfile = GetFname(myFullFile)
With rstStats
.AddNew
!SupplierName = rstSuppliers!SupplierName
!InputFile = MyJustfile & ".csv"
!FullFile = myFullFile
!IPdate = Now()
!OrigDate = FileDateTime(myFullFile) ' Returns "2/12/93 4:35:47".
.Update
End With
myFFound = Dir() 'same as last
Loop While myFFound <> ""
rstSuppliers.Edit
rstSuppliers!LatestFiles = myGoodFiles
rstSuppliers!LatestDate = Now()
rstSuppliers.Update
End If
Else ' no .csv files found
GoTo Convert_NextSupplierName
End If
rstGoodOpen = False
If myGoodFiles = 0 Then GoTo Convert_NextSupplierName
' no named input files found
' now process rststats for this SupplierName in date order
mySQL = "SELECT * FROM LatestStats WHERE SupplierName = '" & rstSuppliers!SupplierName & "' And ignore = False "
mySQL = mySQL & "ORDER BY OrigDate, InputFile; "
Set rstGoodStats = myDB.OpenRecordset(mySQL)
rstGoodOpen = True
Do
' ** set up next file to process
myFullFile = rstGoodStats!FullFile

'strips path and ext
MyJustfile = GetFname(myFullFile)
myIPfile = MyJustfile & ".csv"
myOPfile = MyJustfile & ".xls"
myTempXLSFile = myIPpath & myOPfile
'log it
Print #3, Now() & " Found File " & myIPfile
Me.Repaint ' or requery?

CheckAndProcessFile

rstGoodStats.MoveNext
Loop While Not rstGoodStats.EOF
MoveADR:
' move ip adr to op - at end of Customer not file !!
myTemp = myIPpath & myPrefix & ".adr"
myTemp2 = myOPpath & myPrefix & ".adr"
FileCopy myTemp, myTemp2
Kill myTemp

Convert_NextSupplierName:
Me.Repaint
Me.Recalc
rstSuppliers.MoveNext
If rstSuppliers.EOF Then Exit Do
Loop


Convert_exit:
DoCmd.SetWarnings True
If rstStatsOpen = True Then
rstStats.close
Set rstStats = Nothing
End If
If rstGoodOpen = True Then
rstGoodStats.close
Set rstGoodStats = Nothing
End If
If rstSuppOpen = True Then
rstSuppliers.close
Set rstSuppliers = Nothing
End If

Set fs = Nothing

myDB.close
Set myDB = Nothing
On Error GoTo 0

DoCmd.close ' close this form
Close #3

End Sub

 

[PHV]

Replace this:
DoCmd.close ' close this form
with this
Cancel = True ' close this form

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[PizMac]

that first put up an error box saying open form action cancelled -I then put an 'on error resume next' in to prevent it showing and then the system hung!
It made me think however and I have now added a
'DoCmd.close acForm, stDocName'
immediately after the open and will see if that has any effect - I don't expect it too though! - won't know until next weekend probably

 

[vbajock]

I have an unattended application that runs on a timer event that did exactly that. Ran fine for days, then it would return that error. Turned out to be a database corruption issue. I fixed it by putting in a compact routine in my timer event that compacted the db every day at a certain time:

Public Sub CompactDB()
Dim funcname as string

On Error GoTo Err_h
funcname = "CompactDB"
CommandBars("Menu Bar"). _
Controls("Tools"). _
Controls("Database utilities"). _
Controls("Compact and repair database..."). _
accDoDefaultAction
Exit Sub

Err_h:
Call sErrorHandler(Error$, funcname)

End Sub

 

[PizMac]

Thanks vbaJock - I'll try it and let you know

 

[vbajock]

When you get the error, just do a manual compact/repair. The next time you open it, it will be gone, for awhile.

You can trigger that compact routine off other events, bracketing it in an If (DayofWeek=Someday) Then run routine thing. If you call it from your main form that is automatically opened, plug in a message box to the user to the effect it is doing system maintenance, a little parameter table to record the date so it doesn't run it more than once on a given day, and you are in business. it will do the compact and then automatically reopen to the main form.

 

[MazeWorX]

ever heard of Scheduled Tasks? At best your app will leak memory until the system crashes or eventually corrupt. Does it need to run 24hrs? if not compact on close with a timer and start it with a scheduled task. You can use a switch in the access command line to start the db with a macro which can run the code

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work" <<Edison>>

 

[PizMac]

thanks both of you
vbaJock - at the moment the user just closes down the database and re-opens and the error is gone so I'm not convinced a compact will fix it - but as that also does a re-open then it may be the best option. It often crashes at the weekend when it is needed most so asking them to do it manually is not an option,

MazeWorx - thanks for your input but it does need to run continuously as it picks up files dropped into a folder by external users at any time - and I have another application virtually the same that never has a problem - but I can't see any real differences in the code... so I need a "fix

 

[PizMac]

vbajock - I've tried it but I get
"You can't compact the open database while running a macro or Visual Basic code"
I've looked that up and found various postings but it doesn't seem to work for me no matter how I do it - have you actually got it to work?

 

[vbajock]

The code I posted runs a compact every hour on a job thats been running for like, five years, so I'd say yes, I got it to work. Are you sure you don't have any unsaved edits in your code window or something? Does another user have it open?

 

[PizMac]

well I just don't know - you must have a magic touch!

And - no-one else has it open as I'm currently running it stand-alone on my personal PC

 

[PizMac]

vbaJock - if you're feeling very generous you could upload the form for me to check out any differences? Asking a lot I know... thanks for all the help so far anyway

 

[vbajock]

Did you put that sub in the form module or a separate code module? It should be in a separate code module. That might be your problem.

 

[PizMac]

now in separate module and still
"You can't compact the open database while running a macro or Visual Basic code"

sigh sigh.......

 

[MazeWorX]

The code works fine if its placed in a code module. The error message is telling you there is a function or macro currently running when you try to compact. Figure out which one is running shut it down run the compact code restart the function/macro you shut down

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work" <<Edison>>