Rocky Smolin - Beach Access Software
bchacc at san.rr.com
Wed Aug 9 10:42:11 CDT 2006
Jim:
Well, I used an earlier solution posted here of trying to create the
object when the app starts. If the object can't be created then in the
error trap I set a global variable to false. On the Main Menu then if
the variable is false I disable the command button that opens the label
printer form.
Your method would be more simpler. Until, of course, the user decides
to move the whole app somewhere else. (Users...you gotta love 'em.)
Rocky
Jim Lawrence wrote:
> Hi Rocky:
>
> If the bartender.exe file is supposed to resides in a specific location why
> no check that location. If the file is not there no reference is possible.
>
> Just a thought
> Jim
>
> -----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 4:00 PM
> To: Access Developers discussion and problem solving
> Subject: Re: [AccessD] Removing a missing reference]
>
> 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 *********
>>
>>
>
>
--
Rocky Smolin
Beach Access Software
858-259-4334
www.e-z-mrp.com