Rocky Smolin - Beach Access Software
bchacc at san.rr.com
Tue Aug 8 18:00:09 CDT 2006
Charlotte:
Thanks for all the code. Unfortunately I'm getting the same problem
when looking at this missing reference on your line of code strRefPath =
objRef.FullPath. Error reads: Method 'FullPath' of object 'Reference'
failed (A2K).
I think it's because there is no reference there. The app being
referred to isn't on the machine. So I think it's more a question of
getting that box unchecked than deleting a reference which doesn't
really exist (or are those the same things?).
Thanks and regards,
Rocky
Charlotte Foust wrote:
> 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 *********
>