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