Solved Access keeps crashing when trying to open ACCDB master file (MS Access for Microsoft 365 MSO 64-bit)

AOB

Registered User.
Local time
Today, 18:18
Joined
Sep 26, 2012
Messages
617
Hi there,

I've been making some modifications recently to an Access DB that's been in production for several years. Standard FE/BE split design, single BE ACCDB sitting on a network drive and distributed FE ACCDE's. I have a master copy of the FE locally and I make whatever updates are necessary there, test and generate the ACCDE and distribute as necessary.

For some reason, in the last two days, whenever I try to open the local master ACCDB (with the recent modifications in it, ready to deploy), Access keeps crashing. Every single time, without fail. This is the dialog that appears :

Microsoft-Access-Has-Stopped-Working.png


This has only started happening in the last day or two - I was able to open it with no issues at the start of the week. So I presumed I must have changed something I shouldn't have. However :
  • If I hold the Shift key when opening the file (to prevent any code running), it opens no problem
  • I do have an AutoExec macro which kicks off some basic startup routines - but none of that process has changed in 2 years - and this problem didn't exist 3 days ago
  • The VBA Project compiles with no issue and I've tested the code and there is nothing untoward within it (Option Explicit, Option Compare Database etc. all present)
  • I've Compacted & Repaired the file multiple times but it has no effect
  • I've decompiled the file, then C&R + recompile + C&R again, close - still crashes when I try to reopen it
  • I've created a brand new blank database and imported all the tables, forms, queries, modules, macros etc. - but still can't open it
  • I've tried saving it as an ACCDE but I get the same crash message each time
  • I've plenty of system resource (CPU + memory) at my disposal and have tried rebooting the device just in case but no effect
  • It's not a particularly large file (<3MB) and the BE is even smaller (~600kB) so resource shouldn't be an issue anyway (it doesn't consume much in general use either)
  • If I click "Close the Program" on the dialog, Access "tries to recover my information" indefinitely (I eventually have to just cancel it)
  • If I click "Debug the Program" on the dialog, Access just closes, leaving the record-locking file LACCDB in the folder. I then re-open the file with the Shift key depressed, close it again, and the record-locking file disappears. But I still can't open it "normally".
I've tried literally everything I can think of and I simply can't get the thing to open (without using the Shift key). I wouldn't care so much if I could just convert it to ACCDE and test that but I can't even do that and there's no indication as to why it keeps happening. I'm now getting worried that I won't be able to package the latest updates that the users are waiting on.

Would appreciate any insights anybody might be able to provide!

Thanks
 
Figured it out... As usual, 4 hours of debugging, then as soon as I post a question on here, I figure it out myself... Sorry!...

So it looks like it's an API that was added when this was first developed in Access 2013 which is now being troublesome in A365 (or whatever it's supposed to be called)

TBH I'm happy to simply dump the API as it's not essential - basically, it was inserted to try to pull the list of available fonts for the local system (don't ask...) and dump them into a table - as you can see, it's not a very smart way of doing it (but it worked - or, at least, it used to...)

If anybody has a more appropriate way of achieving the same result without using CopyMemory 😬 then I'd be all ears! But for now I'm just going to comment it out / not call the function...

Code:
Option Compare Database
Option Explicit

#If VBA7 Then
    Declare PtrSafe Function EnumFonts Lib "gdi32" Alias "EnumFontsA" (ByVal hDC As LongPtr, ByVal lpsz As String, ByVal lpFontEnumProc As LongPtr, ByVal lParam As LongPtr) As Long
    Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
#Else
    Declare Function EnumFonts Lib "gdi32" Alias "EnumFontsA" (ByVal hDC As Long, ByVal lpsz As String, ByVal lpFontEnumProc As Long, ByVal lParam As Long) As Long
    Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
    Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
    Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
#End If

Private Const LF_FACESIZE = 32
Type LOGFONT
        lfHeight As Long
        lfWidth As Long
        lfEscapement As Long
        lfOrientation As Long
        lfWeight As Long
        lfItalic As Byte
        lfUnderline As Byte
        lfStrikeOut As Byte
        lfCharSet As Byte
        lfOutPrecision As Byte
        lfClipPrecision As Byte
        lfQuality As Byte
        lfPitchAndFamily As Byte
        lfFaceName(LF_FACESIZE) As Byte
End Type

Public Function GetAvailableFonts() As Boolean
    
    On Error GoTo ErrorHandler
    
    Dim dbs As Database
    
    Set dbs = CurrentDb
    dbs.Execute "DELETE * FROM tblFonts", dbFailOnError
    
    EnumFonts GetDC(Application.hWndAccessApp), vbNullString, AddressOf EnumFontProc, 0
    GetAvailableFonts = True
    
Exit_GetAvailableFonts:
    On Error Resume Next
    Set dbs = Nothing
    Exit Function

ErrorHandler:
    GetAvailableFonts = False
    Call LogError(Err.Number, Err.Description, "GetAvailableFonts", "modFontFunctions", , False)
    Resume Exit_GetAvailableFonts
    
End Function

Private Function EnumFontProc(ByVal lplf As Long, ByVal lptm As Long, ByVal dwType As Long, ByVal lpData As Long) As Long
    
    On Error GoTo ErrorHandler
    
    Dim dbs As Database
    Dim recAvailableFonts As Object
    Dim strSQL As String
    Dim LF As LOGFONT
    Dim FontName As String
    Dim ZeroPos As Long
    
    CopyMemory LF, ByVal lplf, LenB(LF)
    FontName = StrConv(LF.lfFaceName, vbUnicode)
    ZeroPos = InStr(1, FontName, Chr$(0))
    If ZeroPos > 0 Then FontName = Left$(FontName, ZeroPos - 1)
    
    Set dbs = CurrentDb
    strSQL = "SELECT F.FontName " & _
                "FROM tblFonts F " & _
                "WHERE F.FontName = " & Chr(34) & FontName & Chr(34)
    Set recAvailableFonts = dbs.OpenRecordset(strSQL)
    
    With recAvailableFonts
        If (.BOF And .EOF) Then
            .AddNew
            .Fields("FontName").Value = FontName
            .Update
        End If
    End With
    
    EnumFontProc = 1

Exit_EnumFontProc:
    On Error Resume Next
    recAvailableFonts.Close
    Set recAvailableFonts = Nothing
    Set dbs = Nothing
    Exit Function

ErrorHandler:
    Call LogError(Err.Number, Err.Description, "EnumFontProc", "modFontFunctions", , False)
    Resume Exit_EnumFontProc
    
End Function
 
I've had a few of these dbs. No amount of repair seems to help.
Do you have PTRSAFE on all the api declares?

Sometimes a db wont open in 1 pc, yet does on another. No matter what, i had 1 db that would not work on a particular pc.

1 thing may fix, create a blank db in Acc365, then import EVERYTHING, tbls, qrys, relationships, etc.
There may be some tweeks to be made but it can fix it.

 
Yeah I followed the rabbit hole to that CopyMemory API, it was already PTRSAFE'd but there must be something twitchy between it and O365 which I really can't be bothered researching (it's a nice-to-have rather than an essential) Like I say, if there's a way of pulling the system fonts into a list without taking that route, I'd happily switch it in, but in lieu of that, I'll just remove it entirely for now.
 

Users who are viewing this thread

Back
Top Bottom