[AccessD] Broken References in Runtime AXP and A97. Solved!

Gustav Brock gustav at cactus.dk
Wed Jul 23 14:25:17 CDT 2003


Hi Charlotte

Warning: Long posting.
Notice the change of subject.

> I've tested the macro repeatedly in XP and haven't had any errors.  It
> compiles the application properly after fixing the reference with nary a
> squawk.  The undocumented SysCmd never did.  Nice to see there has been
> *some* improvement in 2002!  Does the macro work in A97 if you use just
> compileallmodules instead of compile and save?

No, it errors out because the compile commandbar isn't visible in A97
when a module or the debug window isn't visible.

But you gave me an idea!!

If you open a module from the AutoExec macro, then the commandbar is
visible and - bingo - that's it!

Now, add to this that you can wrap the hole macro in Echo False/True
to prevent the flickering from the opened and closed query and module.

So here is the ready AutoExec macro converted to VBA for easy reading:

<macro>

'------------------------------------------------------------
' AutoExec
'
'------------------------------------------------------------
Function AutoExec()

  DoCmd.Echo False, ""
  If (CheckReferences() = False) Then
    Call VerifyReferences(True)
    DoCmd.OpenModule "USysReferencesCheck", ""
    DoCmd.RunCommand acCmdCompileAndSaveAllMod
    DoCmd.Close , ""
  End If
  DoCmd.Echo True, ""

End Function

</macro>

This assumes the existence of a module USysReferencesCheck.
This is an empty module with no code. Just create and save.

Further, to round things up for anybody else than Charlotte, here's
the modified code for A97 needed for this setup to run:

<code>

Public Function CheckReferences() As Boolean

' Try to check - without using DAO or ADO - if a reference is broken by
' running a query with an expression using a "standard" built in function.
' Example of query string using Right():
'   SELECT TOP 1 Id, Date() AS Check FROM MSysObjects;
'
' As the query will flash briefly when opened, resize it to minimum size
' and position it in a corner of the app window before saving it.
'
' Returns True if references were OK or could be validated successfully.
'
' 2001-08-01. Cactus Data ApS. CPH.
'
' 2003-07-23.
'   Changes:
'   Call of VerifyReferences() moved to the calling macro.
'   Thus, parameter 0 is removed.

  ' Query with expression that may fail.
  Const cstrRefQry          As String = "USysQryReferencesCheck"
  ' Errors to trap.
  ' Error 2001: Query is "too complex".
  Const clngRefError1       As Long = 2001
  ' Error 3075: Function isn't available in expressions in query expression.
  Const clngRefError2       As Long = 3075
  
  Dim lngError              As Long
  Dim booChecked            As Boolean
    
  On Error Resume Next
  
  ' Run the query and record a possible error.
  DoCmd.OpenQuery cstrRefQry, acViewNormal
  ' If error clngError is raised, a reference is missing.
  lngError = Err.Number
  ' Close checking query.
  DoCmd.Close acQuery, cstrRefQry
  
  Select Case lngError
    Case 0
      ' No errors.
      booChecked = True
    Case clngRefError1, clngRefError2
      ' At least one reference is missing.
      ' Return False to allow VerifyReferences(True) to run.
    Case Else
      ' Another error occurred.
      ' Return False.
  End Select
  
  CheckReferences = booChecked

End Function

Public Function VerifyReferences(ByVal booErrorDisplay As Boolean) As Boolean

' Verify Access' external references and re-establish these if possible.
' Uses function IsBroken97().
'
' 2001-07-29. Cactus Data ApS, CPH.
' 2003-07-23.
'   Changes:
'   Added call to DoCmd.Echo True to allow for display of MsgBox.
'   Removed call to SysCmd() compilation which did not work.

  Dim refA                    As Access.Reference
  Dim refX                    As Access.Reference
  Dim strRefFullPath          As String
  Dim booNotBuiltInRefExists  As Boolean
  Dim booIsBroken             As Boolean
  Dim booRefIsMissing         As Boolean
  Dim strMsgTitle             As String
  Dim strMsgPrompt            As String
  Dim strMsgHeader            As String
  Dim strMsgFooter            As String
  Dim lngMsgStyle             As Long
  Dim strCrLf                 As String
  
  ' No special error handling.
  On Error Resume Next
  
  ' User oriented error message.
  strMsgTitle = "Missing support file"
  strMsgHeader = "One or more supporting files are missing:" & vbCrLf
  strMsgFooter = vbCrLf & vbCrLf & "Report this to IT support." & vbCrLf
  strMsgFooter = strMsgFooter & "Program execution cannot continue."
  lngMsgStyle = vbCritical + vbOKOnly
  
  ' Look for the first reference in the database other than
  ' the built in "Access" and "Visual Basic for Applications".
  For Each refA In Access.Application.References
    If refA.BuiltIn = False Then
      ' At least one not built in reference is in use.
      booNotBuiltInRefExists = True
      ' Check if the reference is not broken.
      If IsBroken97(refA) = False Then
        ' The first not missing not built in reference is found.
        Set refX = refA
        Exit For
      End If
    End If
  Next
  
  If booNotBuiltInRefExists = False Then
    ' Only built in references are in use.
    ' Nothing more to do.
  Else
    If refX Is Nothing Then
      ' All not built in references are missing.
      ' Don't remove missing references as there is no way to
      ' re-establish a reference if its identity is lost.
    Else
      ' Remove this not built in reference and add it back to
      ' force Access to revalidate all references.
      ' This may or may not rebuild links to missing references.
      With Access.Application.References
        strRefFullPath = refX.FullPath
        .Remove refX
        .AddFromFile strRefFullPath
      End With
      Set refX = Nothing
    End If
    ' Check references if any should be missing.
    ' If so, no attempt to read a reference is done as it most likely
    ' either is not installed or has been moved to an unknown directory.
    For Each refA In Access.Application.References
      booIsBroken = IsBroken97(refA)
      If booIsBroken = True Then
        ' Build list of missing files.
        strMsgPrompt = strMsgPrompt & vbCrLf & refA.FullPath
      End If
      booRefIsMissing = booRefIsMissing Or booIsBroken
    Next
  
    ' If any reference is broken, display error message if requested.
    If booRefIsMissing = True And booErrorDisplay = True Then
      strMsgPrompt = strMsgHeader & strMsgPrompt & strMsgFooter
      Access.Application.DoCmd.Beep
      Access.DoCmd.Echo True
      VBA.MsgBox strMsgPrompt, lngMsgStyle, strMsgTitle
    End If
  End If
  
  Set refA = Nothing
  
  ' If References have been updated, the application is left decompiled.
  ' Run command in AutoExec macro to compile and save all modules.
   
  VerifyReferences = Not booRefIsMissing

End Function

</code

The function IsBroken97() is needed as well but I have posted it
recently.

Thanks Charlotte. I was feeling half an idiot last time this subject
was brought up because no one could confirm this behaviour of A97.

/gustav


> If I run such a macro in A97 it tells, when trying to compile and save,
> that "this command or action isn't available right now" ... and errors
> out.

> If it works in Access XP, this is a different or improved behaviour
> compared to A97.

> To circumvent this in A97 I had to use the method with the form and a
> timer which I described in my message 2003-07-19 08:11.

> And yes, your macro can use the condition:

>   FixReference()=True

> /gustav


>> OK, here's the situation as it stands.  Using a query, as Gustav 
>> suggested, seems to give me an accurate way to test for a broken 
>> reference.  I call that test from my FixReference routine and if it's 
>> true, I repair the library reference by removing it add adding it 
>> back. RefLibPaths gives me the correct path for adding it back, so 
>> that part is easy.  This works in runtime or full installation and 
>> only performs the fix if the reference is actually broken.

>> The compile issue is a bit trickier and I found a kludge, but I'm open

>> to suggestions if anyone has them.  The undocumented SysCmd(504, 
>> 16483) doesn't error but it doesn't seem to compile either.  I ran 
>> into a post on the net that suggested it might not work with modules 
>> open (didn't say how you ran code otherwise, but I assume the 
>> reference was to the 97
>> VBE) so I started thinking "macro".  If found that if I modify my
>> autoexec macro, it will run the compile for me.  So an autoexec that
>> looks like this compiles the app after fixing the reference:

>> Condition                          Action
>> Command
>> IIf(FixReference()=True,True,False)
>> ...                             RunCommand
>> CompileAndSaveAllModules
>>                                 OpenForm
>> frmSplash

>> Charlotte Foust



More information about the AccessD mailing list