[AccessD] Removing a missing reference]

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 ********* 
>   




More information about the AccessD mailing list