[AccessD] Removing a missing reference

Charlotte Foust cfoust at infostatsystems.com
Tue Aug 8 15:28:11 CDT 2006


Rocky,

I won't guarantee this will work, but here's the code I finally came
down to several years ago.  When you're checking references, you cannot
use any built-in constants, and everything has to be fully
disambiguated.

Charlotte

'******** Begin Module *********
Attribute VB_Name = "basReferences"
Option Compare Database
Option Explicit

Public Function TestReference()
' loops through references collection and attempts to repair broken
references
' by removing and adding back the reference.  For the Redemption code
library,
' attempts to set the reference to the folder where this is placed by
default.
' Disambiguation is used to prevent this code from breaking when there
are broken
' references in the project.

    Dim objRef As Access.Reference
    Dim strRefPath As String
    Dim strFile As String
    Dim strAccessPath As String
    Dim strMsg As String
    Dim strLogTxt As String
    Dim intCount As Integer
    
    On Error GoTo TestReference_err
    
    ' *** this for testing only
    strLogTxt = "Broken  References = " &
Access.Application.BrokenReference
    strLogTxt = strLogTxt & VBA.Chr(13) & VBA.Chr(10) & "Runtime = " &
Access.Application.SysCmd(6)
    RefAddEvent "REF", "TestReference", strLogTxt
    ' ***
    strLogTxt = ""
    
    ' check for broken references
    For intCount = Access.Application.References.Count To 1 Step -1
        Set objRef = Access.Application.References(intCount)
        
        ' store the full path of the reference and the filename itself
        strRefPath = objRef.FullPath
        strFile = VBA.Mid(strRefPath, VBA.InStrRev(strRefPath, "\") + 1)
        strRefPath = VBA.Left(strRefPath, VBA.InStr(strRefPath, strFile)
- 1)
        
        ' if we're dealing with Redemption, try to set it to the
        ' Access runtime path
        If VBA.InStr(objRef.Name, "RIMCDORedemption") > 0 Then
            strLogTxt = "Reference Path: " & objRef.Name & VBA.Chr(13) &
VBA.Chr(10) _
                        & objRef.FullPath
                        
            ' store the runtime path
            strAccessPath = Access.Application.SysCmd(9)
            strLogTxt = strLogTxt & VBA.Chr(13) & VBA.Chr(10) & "Runtime
Engine: " & strAccessPath & VBA.Chr(13) & VBA.Chr(10)
            
            ' we need only the folder portion of the runtime path
            strAccessPath = VBA.Mid(strAccessPath, 1,
VBA.InStrRev(strAccessPath, "\"))
        
            If VBA.Len(VBA.Dir(strRefPath & "RIMCDORedemptionXP.*", 0))
= 0 Or _
                    (objRef.Name <> "RIMCDORedemption" And
VBA.Len(VBA.Dir(objRef.Name, 0)) = 0) Then
                strLogTxt = strLogTxt & VBA.Chr(13) & VBA.Chr(10) &
"Broken reference: " & objRef.Name
        
                If VBA.Len(VBA.Dir(strAccessPath &
"RIMCDORedemptionXP.*")) = 0 Then
                    VBA.MsgBox "You must repair a broken reference which
will otherwise " _
                                & "prevent the application from
functioning normally.", _
                                64, "Warning - Runtime Session Required"
                    strLogTxt = strLogTxt & VBA.Chr(13) & VBA.Chr(10) &
"Not a runtime session."
                    Exit For
             
                Else
                    ' remove the broken and add it back
                    Access.Application.References.Remove objRef
                    strLogTxt = strLogTxt & VBA.Chr(13) & VBA.Chr(10) &
"Broken Reference removed"
                    Access.Application.References.AddFromFile
strAccessPath & strFile
                    strLogTxt = strLogTxt & VBA.Chr(13) & VBA.Chr(10) &
"Reference added:  " _
                                    & VBA.Chr(13) & VBA.Chr(10) &
strAccessPath & strFile
                                    
                    ' if any broken references were handled, recompile
the  project
                    ' See MSKB 194374 for info on SysCmd hidden
arguments
                    ' Note that if we do NOT run the compile, the
repaired reference
                    ' does not seem to "stick" and this will run each
time the app opens
                    Access.Application.SysCmd 504, 16483
                    strLogTxt = strLogTxt & VBA.Chr(13) & VBA.Chr(10) &
"Recompiled Application"
                End If
            End If
            Exit For
        End If
            
    Next intCount
    
TestReference_exit:
    On Error Resume Next
    RefAddEvent "REF", "TestReference", strLogTxt
    Set objRef = Nothing
    Exit Function
TestReference_err:
    RefAddEvent "ERROR", "TestReference: ", strLogTxt & VBA.Chr(13) &
VBA.Chr(10) & VBA.Err.Description
    VBA.MsgBox VBA.Err.Description, 48, "Error " & VBA.Err.Number
    Resume TestReference_exit
    
End Function

Private Sub RefAddEvent(strType As String, strDescription As String,
Optional strDetails As String, Optional fPrint As Boolean)
'  Purpose:     create an event record of the required type
'  Arguments:   strType - type of event - ERROR, STARTSTOP, BACKUP,
CODE,
'               COMMSIN, COMMSOUT, DELETE, ERROR, EXPORT, IMPORT, REPAIR
'               strDescription - simple description
'               strDetails - optional details
'               fPrint - automatically generates a printed report of the
event
'               strTitle - title for report if printed
'  Created:     26-Aug-97     By:   SJW
'  Updated:     07-Oct-98     By:   SJW - add A4 paper size options
'  Updated:     16-Mar-99     By:   SJW - modify A4 paper size options
with SetpaperSize

Dim rstEvent As DAO.Recordset
Dim lngTmp As Long

On Error GoTo AddEvent_Err

Set rstEvent = Access.CurrentDb.OpenRecordset("Select * from EventLog
where 1 = 2", 2)
rstEvent.AddNew
rstEvent!datTimeStamp = VBA.Now()
rstEvent!strType = strType
rstEvent!strSystemID = "NONE"

' truncate the description to 255 chars just in case we have exceeded it
If VBA.Len(strDescription) > 255 Then
    rstEvent!strDescription = VBA.Mid$(strDescription, 1, 255)
    ' if we do not pass details then place the complete description in
details
    If Len(strDetails) = 0 Then
        rstEvent!memDetails = strDescription
    End If
Else
    rstEvent!strDescription = strDescription
    If Len(strDetails) > 0 Then
        rstEvent!memDetails = strDetails
    End If
End If
lngTmp = rstEvent!lngID
rstEvent.Update

AddEvent_Exit:
    On Error Resume Next
    rstEvent.Close
    Set rstEvent = Nothing
    Exit Sub
    
AddEvent_Err:
    VBA.MsgBox "Error: " & VBA.Err.Description, 48, "RefAddEvent"
    Resume AddEvent_Exit
    
End Sub
'******** End Module ********* 

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Rocky Smolin
- Beach Access Software
Sent: Tuesday, August 08, 2006 1:00 PM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] Removing a missing reference

Gustav:

After running this code I find that the missing reference is still
checked.  Any other ideas?

TIA


Rocky


Gustav Brock wrote:
> Hi Rocky
>
> That sounds a bit strange, also regarding the exe-name.
> Here's a function that may help you:
>
> <code>
>
> 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>
>
> - and the IsBroken97 function:
>
> <code>
>
> Public Function IsBroken97(ByVal ref As Access.Reference) As Boolean
>
> ' Alternative method to check if a reference is broken ' as the 
> IsBroken property cannot be used in Access97.
> '
> ' 2000-03-19. Gustav Brock. Cactus Data ApS.
>
> ' Refer to this article at Microsoft Technet:
> '
> ' Article ID: Q186720
> '
> ' The information in this article applies to:
> ' Microsoft Access 97
> '
> ' SYMPTOMS
> ' In Microsoft Access, IsBroken is a property of the References
collection.
> ' The Microsoft Access Help topic on the Isbroken property states the
following:
> '
> ' The IsBroken property returns a Boolean value indicating whether a '

> Reference object points to a valid reference in the Windows Registry.
> '
> ' Although this statement is correct, to receive this Boolean value ' 
> you must trap for errors that are generated by the broken reference.
> ' Also, the IsBroken property becomes True only when the file being 
> referenced ' is deleted and the Microsoft Windows Recycle Bin is
emptied.
> ' This article details the steps necessary to receive the Boolean
value.
>
>   Dim booRefOK As Boolean
>   On Error GoTo Err_IsBroken97
>   
>   If Len(Dir(ref.FullPath, vbNormal)) > 0 Then
>     booRefOK = Not ref.IsBroken
>   End If
>
> Exit_IsBroken97:
>   IsBroken97 = Not booRefOK
>   Exit Function
>
> Err_IsBroken97:
>   ' Ignore non existing servers, drives, and paths.
>   Resume Exit_IsBroken97
>   
> End Function
>
> </code>
>
> /gustav
>
>   
>>>> bchacc at san.rr.com 08-08-2006 20:29:35 >>>
>>>>         
> Gustav:
>
> The code I was using did go backwards through the references but still

> choked on the first one which was the missing reference.  Seems 
> there's nothing in the reference so MsgBox ref.Name fails as well as
.Remove.
>
> Rocky
>
>
> Gustav Brock wrote:
>   
>> Hi Rocky
>>
>> Further to Charlotte's comments, I faintly recall you have to move
backwards in the References collection:
>>
>> Public Function ReferencesClean() As Boolean
>>
>> ' Remove all missing references.
>> ' Return True if no reference was removed.
>> '
>> ' 2001-08-20. Cactus Data ApS, CPH.
>>
>>   Dim ref         As Reference
>>   Dim lngItem     As Long
>>   Dim booMissing  As Boolean
>>   
>>   With References
>>     For lngItem = .Count To 1 Step -1
>>       Set ref = .Item(lngItem)
>>       If ref.BuiltIn = True Then
>>         ' No need to check built in reference.
>>       ElseIf IsBroken97(ref) Then
>>         .Remove ref
>>         booMissing = True
>>       End If
>>     Next
>>   End With
>>   
>>   Set ref = Nothing
>>   
>>   ReferencesClean = Not booMissing
>>   
>> End Function
>>
>> Still, your code will be left non-compiled after this. A method to
compile the code is described by Charlotte and me if you search the
archives of July 2003 for:
>> "Broken References in Runtime AXP and A97"
>>
>> /gustav
>>
>>   
>>     
>>>>> bchacc at san.rr.com 08-08-2006 19:46:07 >>>
>>>>>         
>>>>>           
>> Dear List:
>>
>> Still struggling with this references thing.  It seem the easiest 
>> thing to do would be to remove the missing reference in the Open 
>> event of the opening form in the event the app is loaded onto a 
>> machine which doesn't have the library.  However, all the code that 
>> I've seen to remove missing references fail.  Code like:
>>
>> Dim refCurr As Reference
>>     For Each refCurr In References
>>         If refCurr.IsBroken Then
>>             References.Remove refCurr
>>         End If
>>     Next
>>
>> Seems straightforward but when it comes to the missing reference it 
>> errors out on the .Remove line because it doesn't have a name.  So.  
>> How do you remove a missing reference when the application the 
>> reference is referring to doesn't exist?
>>
>> MTIA
>>
>> Rocky
>>     
>
>   

--
Rocky Smolin
Beach Access Software
858-259-4334
www.e-z-mrp.com

--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com



More information about the AccessD mailing list