So I now have the main form opening directly, and all start-up code solely in the main form's Open event, or routines called from the Open event. Still crashes randomly, at three different places. One is immediately into the Open event routine, one is several steps in, in a subroutine named Detour, called from the Open event, and one is again after everything has settled and all my code has stopped executing.
I have the code opening the VBA editor, so that I can see output of the Debug.Print statements. It makes a difference whether I have Access already open, and start the app from there, or have Access closed, and start everything with a double-click from File Explorer. Both crash, but the former crashes less often. Trying to hit Alt-F11 quickly enough after starting from nothing was tricky, so I added this line of code to open the VBE window immediately. This is the main form, with NO other code executing first.
Here is the Open event code:
Code:
Private Sub Form_Open(Cancel As Integer)
Dim i&, j&, k&, ctl As Control, rst As DAO.Recordset, x$, y$
Application.VBE.MainWindow.Visible = True
DoEvents
Debug.Print "O1"
DoEvents ' First crash point is here - debug window prints 01, but not 02. Used to be some code between these two, which I removed, but happened to leave both print statements.
Debug.Print "O2"
' Nechci aby to lidé spouštěli ze sítě, je to náročný na síťový provoz a dělá místní zápisy, což by kolidovalo pro více uživatelů.
' Je to míněné aby si každý stáhl a spustil svou vlastní kopií.
If CurrentProject.Name <> "Paleontologie.accdb" Then
MsgBox "Tato aplikace se musí jmenovat Paleontologie.accdb" & vbCrLf & vbCrLf & "Skutečný název je " & CurrentProject.Name & vbCrLf & vbCrLf & "V tomto stavu nejde spustit.", vbCritical + vbOKOnly, "Špatný název"
Cancel = True
Application.Quit
End If
Debug.Print "O3"
Set FS = CreateObject("Scripting.FileSystemObject")
If Left$(currentdb.Name, 2) = "\\" Then
MsgBox "Tento formulář je určený pro použití jako klient, umístený na místním počítači." & vbCr & vbCr & "Zkopírujte si tento soubor do vlastního počítače a spusťte ho tam.", vbOKOnly + vbCritical, "Chybné spuštění."
Application.Quit
Exit Sub
End If
Debug.Print "O4"
If Not IsLocalDrive(Left$(currentdb.Name, 1)) Then
MsgBox "Tento formulář je určený pro použití jako klient, umístený na místním počítači." & vbCr & vbCr & "Zkopírujte si tento soubor do vlastního počítače a spusťte ho tam.", vbOKOnly + vbCritical, "Chybné spuštění."
Application.Quit
Exit Sub
End If
Debug.Print "O5"
CestaDoServeru_Aplikace = ReadCustomDocumentProperty("CestaDoServeru_Aplikace")
If Right$(CestaDoServeru_Aplikace, 1) <> "\" Then CestaDoServeru_Aplikace = CestaDoServeru_Aplikace & "\"
' Když není mapovaná jednotka, tak nemáme přístup ke správně složce ne serveru, vypadneme.
If Not NetworkPathExists(CestaDoServeru_Aplikace) Then
MsgBox "Cesta '" & CestaDoServeru_Aplikace & "' není dostupná, což musí být, aby databáze fungovala." & vbCr & vbCr & "Obraťte se na síťového správce pro oddělení.", vbOKOnly + vbCritical, "Chybné spuštění."
Application.Quit
Exit Sub
End If
Debug.Print "O6"
CestaDoServeru_Prilohy = ReadCustomDocumentProperty("CestaDoServeru_Prilohy")
If Right$(CestaDoServeru_Prilohy, 1) <> "\" Then CestaDoServeru_Prilohy = CestaDoServeru_Prilohy & "\"
' Když není mapovaná jednotka, tak nemáme přístup ke správně složce ne serveru, vypadneme.
If Not NetworkPathExists(CestaDoServeru_Prilohy) Then
MsgBox "Cesta '" & CestaDoServeru_Prilohy & "' není dostupná, což musí být, aby databáze fungovala." & vbCr & vbCr & "Obraťte se na síťového správce pro oddělení.", vbOKOnly + vbCritical, "Chybné spuštění."
Application.Quit
Exit Sub
End If
Debug.Print "O7"
Detour
Debug.Print "1"
DoEvents
Debug.Print CurrentProject.AllForms("KeepAlive").IsLoaded
DoEvents
' Rozsvítit titul červeně, když používáme pokusná data.
'If Not CurrentProject.AllForms("Start").IsLoaded Then
' MsgBox "Musí se spouštět přes formulář 'Start'", vbCritical, "Nejde spustit samostatně"
' Stop
'' DoCmd.Close ObjectType:=acForm, ObjectName:=Name
'' End
'End If
Debug.Print "1.1"
'PauseHeaderYellow True
SetTitul
Debug.Print "1.2"
gbl_ctlCaption ctl:=lblFiltrTaxLokNmbr, text:=tglFiltrTaxLok.OptionValue
Debug.Print "1.3"
gbl_ctlCaption ctl:=lblFiltrKompletNmbr, text:=tglFiltrKomplet.OptionValue
Debug.Print "1.4"
gbl_ctlCaption ctl:=lblFiltrInventNmbr, text:=tglFiltrInvent.OptionValue
Debug.Print "1.5"
gbl_ctlCaption ctl:=lblFiltrVyberNmbr, text:=tglFiltrVyber.OptionValue
Debug.Print "1.6"
gbl_ctlCaption ctl:=lblFiltrRozsahNmbr, text:=tglFiltrRozsah.OptionValue
Debug.Print "1.7"
gbl_ctlCaption ctl:=lblFiltrOriginNmbr, text:=tglFiltrOrigin.OptionValue
Debug.Print "1.8"
gbl_ctlCaption ctl:=lblFiltrExterniNmbr, text:=tglFiltrExterni.OptionValue
Debug.Print "1.9"
gbl_ctlsClearControlTipText arr:=Array(tglFiltrPolicka, tglFiltrTaxLok, tglFiltrKomplet, tglFiltrInvent, tglFiltrVyber, tglFiltrRozsah, tglFiltrOrigin, tglFiltrExterni)
FilterOn = False
DoEvents
' Nastavit 'příští' akcesitní číslo pro letošní rok
PristiAkcesit
Debug.Print "2"
DoEvents
' Tady už máme jméno ze startovacího formuláře. Jméno do škatulky na formuláři, pak podle toho ovládat viditelnosti a přístupy různých prvků. Startovací jméno dále nepotřebujeme.
With gbl_UzivatelInfo
gbl_ctlCaption ctl:=lblUzivatel, text:=.LclKrestni & " " & .LclPrijmeni
gbl_ctlCaption ctl:=lblPovoleni, text:=Switch(.Kurator, "Kurátor", .CES, "CES-Kurátor", .Admin, "Administrátor", .Uzivatel, "Uživatel", .Knihovnik, "Knihovník", .Host, "Host", True, "??????")
gbl_ctlsVisible arr:=Array(cmdSmazatZ, cmdSmazatZs, cmdPodrobnostiWidth, cmdPodrobnostiWidth), stav:=.Admin
gbl_ctlAble ctl:=cmdEditTaxonomie, stav:=.AsponKurator
DoEvents
gbl_ctlCaption ctl:=cmdDoDo, text:="DoDo"
DoEvents
If .LclKrestni = "Host" Then
gbl_ctlsDisable arr:=Array(cmdRezervCisla, cmdInventVDepozitari, cmdDoDo)
With cmdNovyAkcesit
.Enabled = False
.ControlTipText = ""
End With
Else
cmdNovyAkcesit.ControlTipText = "Nové akcesitní číslo," & vbCrLf & "automaticky dá letos a příští volné číslo."
If .LclSkupina = "Admin" Or .LclSkupina = "CES" Then cmdNovyAkcesit.ControlTipText = cmdNovyAkcesit.ControlTipText & vbCrLf & "Alt / Klik dovolí přidat Akces záznam s libovolném číslem."
gbl_ctlEnable ctl:=cmdDoDo
End If
End With
DoEvents
txt_hdn_Hranice = ReadCustomDocumentProperty("HranicePoctu")
Debug.Print "3"
DoEvents
' Nastavit pucky pro písmenové filtry.
Set rst = currentdb.OpenRecordset("spEvidenceLettersWithCount", dbOpenSnapshot)
DoEvents
Set gbl_LtrFiltrTgls = New Collection
For j = 0 To 89
Set ctl = Controls("tglEL" & Right$(CStr(j + 100), 2))
If rst.EOF Then
gbl_ctlVisible ctl:=ctl, stav:=False
Else
x = rst.Fields("EvidenceLetter")
k = rst.Fields("Kolik")
If x = "1e" Then
tglELPrvni.ControlTipText = "Celkový počet " & x & " záznamů = " & CStr(k)
rst.MoveNext
x = rst.Fields("EvidenceLetter")
k = rst.Fields("Kolik")
gbl_LtrFiltrTgls.Add tglELPrvni, tglELPrvni.Name
End If
If (Len(x) = 1 And (CLng(Right$(ctl.Name, 2)) Mod 3) > 0) _
Or (Len(x) = 2 And Right$(x, 1) = "s" And (CLng(Right$(ctl.Name, 2)) Mod 3) <> 1) _
Or (Len(x) = 2 And Right$(x, 1) <> "s" And (CLng(Right$(ctl.Name, 2)) Mod 3) < 2) Then
i = i + 1
gbl_ctlVisible ctl:=ctl, stav:=False
Else
ctl.Caption = x
ctl.Visible = True
ctl.ControlTipText = "Celkový počet " & x & " záznamů = " & CStr(k) & vbCrLf & "Držením Ctrl se přidá písmeno do zběru." & vbCrLf & "Držením Alt se vypne všechno, kromě drženého."
gbl_ctlAble ctl:=ctl, stav:=k > 0
i = i + 1
rst.MoveNext
gbl_LtrFiltrTgls.Add ctl, ctl.Name
End If
End If
Next j
rst.Close
Set rst = Nothing
DoEvents
rctKatalogFiltry.Height = tglEL00.top - 20 + (283 * ((i + 1) \ 3))
Debug.Print "4"
DoEvents
gbl_ctlVisible ctl:=lblAkcesitChyba, stav:=False
LoadSeznamFilters
DoEvents
CurrentUserFilter
DoEvents
With optAkcesFiltry
.Tag = "FiltrNoRecords"
For i = 0 To .Controls.Count - 1
If Left$(.Controls(i).Name, 3) = "tgl" Then
gbl_ctlVisible ctl:=Controls("lbl" & Mid$(.Controls(i).Name, 4)), stav:=False
gbl_ctlAble ctl:=.Controls(i), stav:=.Controls(i).Name = "tglFiltrVse"
End If
Next i
End With
Debug.Print "5"
DoEvents
' Načíst schované 'pamatovací' pucky posledních šest Akcesitů. Opět se přidaj, jak se budou Akcesity hledat.
For i = 1 To 6
y = "cmdPA" & CStr(i)
x = ReadCustomDocumentProperty(y)
With Controls(y)
If x = ";" Then
.Enabled = False
.Caption = ""
Else
.Enabled = True
j = InStr(x, ";")
.Tag = Left$(x, j - 1)
.Caption = Mid$(x, j + 1)
End If
End With
Next i
Debug.Print "6"
DoEvents
' Vyvolat poslední hodnoty
i = gbl_FilterTextsRozsah.PlusMinus
If i > 0 Then
txt_hdn_PlusMinus = CStr(i)
Else
txt_hdn_PlusMinus = Null
End If
DoEvents
gbl_ctlDisable ctl:=cmd_hdn_NajdiDrEvidPlusMinus
i = gbl_FilterTextsRozsah.PrvniPosledni
If i > 0 Then
txt_hdn_PoslednichX = CStr(i)
gbl_ctlEnable ctl:=cmd_hdn_PoslednichX
Else
gbl_ctlDisable ctl:=cmd_hdn_PoslednichX
End If
DoEvents
sfPodrobnosti.Width = PodrobnostiWide
Debug.Print "7"
DoEvents
' Přepnout formulář na Akcesity nebo jenom druhou evidence.
optAkcesityDruhaEvidence = ReadCustomDocumentProperty("ZobrazeniAkcesityDruhaEvidence")
DoEvents
DoToggle2Evid stav:=optAkcesityDruhaEvidence
DoEvents
FormatlblRS IIf(gbl_UzivatelInfo.Pokusy Or gbl_UzivatelInfo.Admin, "Large", "Small")
Section(0).Height = 1
DoEvents
gbl_ctlCaptionClear ctl:=lblRS
ReloadMaxNumbers
Debug.Print "8"
DoEvents
Set lcl_hldInventDataDepozitar_Akc = New clsDepozitar
Set gbl_PodrobDataDepozitar = New clsDepozitar
DoEvents
With DoCmd
.Maximize
.Close acForm, gbl_UzivatelInfo.SplashForm
End With
'PauseHeaderYellow False
Debug.Print "9"
DoEvents
'Set rs = CurrentDb.OpenRecordset("SELECT top 1 1 from AO_vwStratigrafieLito", dbOpenDynaset, dbSeeChanges)
'rs.MoveLast
'MsgBox rs.RecordCount & " Record queried"
txtSrchAkcesitCely.SetFocus
DoEvents
End Sub
Detour routine, with second crash point:
Code:
Private Sub Detour()
Dim rst As DAO.Recordset, oSysInfo As ActiveDs.WinNTSystemInfo, MachineName$, doc As Object, db As DAO.Database, cnt As DAO.Container, props(), i&, yp$, x$
Debug.Print "Starting detour"
DoCmd.OpenForm "KeepAlive", acNormal, , , , acHidden
Debug.Print "Skipping KeepAlive"
With currentdb
Set qdf_GPsp = .QueryDefs(GPStoredProc)
Set qdf_GPcmd = .QueryDefs(GPStoredCmd)
End With
DoEvents
Debug.Print "GP queries"
' Podíváme se, jestli je novější verze ke stažení. Když je, uživatel by ji měl stáhnout a tedy odsud se už nevrátíme.
TestVersion
DoEvents
Debug.Print "Test version"
' Spojka do databázového motoru.
' Uživatelské jméno. Když běži u mne, zeptá se, jaké jméno má použivat, jinak rovnou vezmě jméno z počítače. Mne také varuje, že se hrabu v živích datech - pro ostatní je takové varování zbytečné.
Set oSysInfo = New ActiveDs.WinNTSystemInfo
gbl_UzivatelInfo.LclUcet = oSysInfo.UserName
Set oSysInfo = Nothing
DoEvents
If gbl_UzivatelInfo.LclUcet = "DanesPe" Then
gbl_UzivatelInfo.StartUzivatelJeDanes = True
gbl_UzivatelInfo.UzivatelJeDanes = True
End If
DoEvents
Debug.Print "SysInfo"
CheckKteraDatabaze
DoEvents
Debug.Print "KteraDB"
' Prints the above, then quits
If gbl_UzivatelInfo.StartUzivatelJeDanes = True Then
DoCmd.OpenForm "StartSelectUzivatel", acNormal, , , , acDialog, "Daneš, Petr"
If Len(gbl_UzivatelInfo.LclUcet) = 0 Then End
End If
DoEvents
Debug.Print "StartSelectUzivatel"
GetDomainUserInfo gbl_UzivatelInfo, gbl_UzivatelInfo.LclUcet
DoEvents
Debug.Print "GetDomainUserInfo"
Set gbl_LtrFltr = New cls_singl_Katalogs
Set gbl_FilterTextsObsah = New cls_singl_FiltrObsah
Set gbl_FilterTextsTaxLok = New cls_singl_FiltrTaxLok
Set gbl_FilterTextsKomplet = New cls_singl_FiltrKomplet
Set gbl_FilterTextsInvent = New cls_singl_FiltrInvent
Set gbl_FilterTextsVyber = New cls_singl_FiltrVyber
Set gbl_FilterTextsRozsah = New cls_singl_FiltrRozsah
Set gbl_FilterTextsOrigin = New cls_singl_FiltrOrigin
Set gbl_FilterTextsExtrn = New cls_singl_FiltrExtrn
DoEvents
Debug.Print "Filter objects"
Set rre = New RegExp
Set gbl_rre_patterns = New cls_singl_DrEvidRegExpPatterns
DoEvents
With currentdb
Set qdf_spAkcesitProCustomFind = .QueryDefs("spAkcesitProCustomFind")
Set qdf_XForm = .QueryDefs("CrosstabOfTables")
Set qdf_PrilohaAkcesitKniha = .QueryDefs("spPrilohaAkcesitKniha")
Set qdf_srchAkc_spAkcesIDSrch = .QueryDefs("srchAkc_spAkcesIDSrch")
Set qdf_srchAkc_AkcesYears = .QueryDefs("srchAkc_spAkcesYears")
Set qdf_spMaxCisla = .QueryDefs("spMaxCisla")
Set qdf_spMaxAkcesitLetos = .QueryDefs("spMaxAkcesitLetos")
Set qdf_vwPrvniAkcesit = .TableDefs("RO_vwPrvniAkcesit")
Set qdf_FiltrVyber = .QueryDefs("spFiltrVyber")
Set qdf_lcl_FiltrVyberClear = .QueryDefs("lcl_FiltrVyberClear")
Set qdf_lcl_SeznamZaznamuPocet = .QueryDefs("lcl_SeznamZaznamu_Pocet")
Set qdf_lcl_SeznamZaznamuClear = .QueryDefs("lcl_SeznamZaznamuClear")
Set qdf_PodrobnostiNaHlavnimPocetAkcesitu = .QueryDefs("Alles_spPodrobnostiNaHlavnimPocetAkcesitu")
Set qdf_PodrobnostiNaHlavnimPrvniAkcesit = .QueryDefs("Alles_spPodrobnostiNaHlavnimPrvniAkcesit")
Set qdf_PodrobnostiNaHlavnimStandard = .QueryDefs("Alles_spPodrobnostiNaHlavnim")
Set qdf_PodrobnostiNaHlavnimVsePolicka = .QueryDefs("Alles_spPodrobnostiNaHlavnimVse")
Set qdf_PodrobnostiJenAutoID = .QueryDefs("Alles_spPodrobnostiJenAutoID")
Set qdf_PodrobnostiCelyID = .QueryDefs("Alles_spPodrobnostiCelyID")
Set qdf_PodrobnostiNaHlavnimMaZaznamVAkcesitu = .QueryDefs("Alles_spPodrobnostiNaHlavnimMaZaznamVAkcesitu")
Set qdf_PodrobnostiNaHlavnimMaZaznamKdekoli = .QueryDefs("Alles_spPodrobnostiNaHlavnimMaZaznamKdekoli")
Set qdf_PodrobnostiNaHlavnimPocetPodrobnosti = .QueryDefs("Alles_spPodrobnostiNaHlavnimPocet")
Set qdf_SousediciAkcesity = .QueryDefs("Alles_spSousediciAkcesity")
Set qdf_SousediciAkcesityPodleVyberu = .QueryDefs("Alles_spSousediciAkcesityPodleVyberu")
gbl_LtrFltr.LoadAll "1e," & .OpenRecordset("RO_vwEvidenceLettersString").Fields("Letters")
End With
DoEvents
Debug.Print "Record source queries"
LoadAkcesitDotazy
LoadPodrobnostiNaHlavnimDotazy
DoEvents
' Ukážeme startovací formulář, podle jména uživatele.
With gbl_UzivatelInfo
.SplashForm = SetSplashForm
DoCmd.OpenForm .SplashForm
DoEvents
' Připravíme formulář k použití, částenčně podle současného uživatele.
gbl_ctlVisible ctl:=Forms(.SplashForm).lblStartuje, stav:=True
DoEvents
FadeBack Forms(.SplashForm).lblStartuje, 0
End With
DoEvents
Debug.Print "Splash form"
' První spuštění?
' Smazat staré výbery. Když databáze naposledy běžela na jiném compu, nejspíš u mně, a tedy moje výběry by se měli smazat, a načíst staré, uložené místním uživatelem.
' Ale taky tady nemusí být stará kopie, když je to první spuštění v novém účtu nebo novém compu.
currentdb.Execute "DELETE * FROM lcl_FiltrVyber"
MachineName = fOSMachineName
DoEvents
Debug.Print "Clear lcl_FiltrVyber"
If MachineName <> ReadCustomDocumentProperty("CompKdeNaposledyBezel") Then
yp = Left$(currentdb.Name, InStrRev(currentdb.Name, ".")) & "hld"
WriteCustomDocumentProperty "CompKdeNaposledyBezel", MachineName
' Je v této mašině stará kopie? Jenom když ano můžeme načíst z ní staré hodnoty.
If FS.FileExists(yp) Then
Set db = CreateObject("DAO.DBEngine.36").OpenDatabase(yp, False, True)
Set cnt = db.Containers(1)
Set doc = cnt.Documents("UserDefined")
props = Array("FiltrovaciPismena", "JazykTextu", "Zobrazeni2Evidence", "cmdPA1", "cmdPA2", "cmdPA3", "cmdPA4", "cmdPA5", "cmdPA6", "ZobrazeniAkcesityDruhaEvidence", "GPSFormat", "Aret2EvidEvidoval", "Aret2EvidPrepsal", "HranicePoctu", "PlusMinusPodrobnosti", "FiltrRozsah")
With doc
On Error Resume Next
For i = LBound(props) To UBound(props)
WriteCustomDocumentProperty props(i), .Properties(props(i))
Next i
On Error GoTo 0
End With
Set doc = Nothing
Set cnt = Nothing
Set db = Nothing
On Error Resume Next
Kill yp
On Error GoTo 0
End If
End If
DoEvents
Debug.Print "Check for old copy"
' Načist speciální čísla, abychom je nemuseli pak hledat a spojovat
Set rst = currentdb.OpenRecordset("RO_vwAkcesRubbishHeap", dbReadOnly)
With rst
Do Until .EOF
AkcesAutoIDRubbishList = AkcesAutoIDRubbishList & CStr(.Fields(0)) & ","
.MoveNext
Loop
.Close
AkcesAutoIDRubbishList = Left$(AkcesAutoIDRubbishList, Len(AkcesAutoIDRubbishList) - 1)
End With
Set rst = Nothing
DoEvents
Debug.Print "Rubbish list"
Set AkcesRecord22011 = New clsAkcesRecordData
AkcesitNajdi paramAkcesStatus:=AkcesStatus, SrchAkc:="22011", UkazatForm:=False
If AkcesStatus.CoSeStalo <> AkcStatus.NaselOK Then Stop
AkcesRecord22011.NalozitAkcesZaznam AkcesAutoID:=AkcesStatus.GoToAkcesAutoID
Set AkcesRecord35050 = New clsAkcesRecordData
AkcesitNajdi paramAkcesStatus:=AkcesStatus, SrchAkc:="35050", UkazatForm:=False
If AkcesStatus.CoSeStalo <> AkcStatus.NaselOK Then Stop
AkcesRecord35050.NalozitAkcesZaznam AkcesAutoID:=AkcesStatus.GoToAkcesAutoID
Set AkcesRecord36675 = New clsAkcesRecordData
AkcesitNajdi paramAkcesStatus:=AkcesStatus, SrchAkc:="36675", UkazatForm:=False
If AkcesStatus.CoSeStalo <> AkcStatus.NaselOK Then Stop
AkcesRecord36675.NalozitAkcesZaznam AkcesAutoID:=AkcesStatus.GoToAkcesAutoID
Set AkcesRecordRezervovana = New clsAkcesRecordData
AkcesitNajdi paramAkcesStatus:=AkcesStatus, SrchAkc:="999999999/9999", UkazatForm:=False
If AkcesStatus.CoSeStalo <> AkcStatus.NaselOK Then Stop
AkcesRecordRezervovana.NalozitAkcesZaznam AkcesAutoID:=AkcesStatus.GoToAkcesAutoID
Set AkcesRecordInventarizovana = New clsAkcesRecordData
AkcesitNajdi paramAkcesStatus:=AkcesStatus, SrchAkc:="888888888/9999", UkazatForm:=False
If AkcesStatus.CoSeStalo <> AkcStatus.NaselOK Then Stop
AkcesRecordInventarizovana.NalozitAkcesZaznam AkcesAutoID:=AkcesStatus.GoToAkcesAutoID
Set AkcesRecordImportovany = New clsAkcesRecordData
AkcesitNajdi paramAkcesStatus:=AkcesStatus, SrchAkc:="777777777/9999", UkazatForm:=False
If AkcesStatus.CoSeStalo <> AkcStatus.NaselOK Then Stop
AkcesRecordImportovany.NalozitAkcesZaznam AkcesAutoID:=AkcesStatus.GoToAkcesAutoID
DoEvents
Debug.Print "Special Akcesits"
gbl_ImportPath = PaleoAppPath
With DoCmd
' .OpenForm "Akces", acNormal, , , , acWindowNormal
DoEvents
Form_Akces.SetFocus
DoEvents
Form_Akces.txtSrchAkcesitCely.SetFocus
DoEvents
' .Close acForm, Name
End With
Debug.Print "Set focus"
End Sub
Since it sometimes quits before anything at all has happened, besides opening the VBE window, it looks as if something in the structure is corrupt. I guess I'll try importing everything into a new database again, and if the issue persists, try cutting out pieces to see if I can make it stop - simply removing forms and reports. This will obviously make it crash if I wander into code that tries to refer to such objects, but at least the start-up should work. If something I remove suddenly makes it stop crashing, I will have something further to investigate