List Broken References via code? 1

[FancyPrairie]

Often times I will distribute an access db to my users and when they launch it, it crashes because it's missing a reference to something. Since the user has only the runtime version of access on their machine, it's a hasstle to determine what reference they're missing. I've written some code to list the broken references.

Suppose the database I'm trying to open has a broken reference. The problem I'm having is that the autoexec file executes when I open the database (via code) and then gives me a compile error (since it's missing a referenece).

So, my question is...How do I open an access database via code so that it bypasses the autoexec macro?

I'm using this syntax...accApp.OpenCurrentDatabase DBName

Note that in the code below, I commented out code that had to do with saving the stuff to a table, etc.

Here's my code:

Option Compare Database
Option Explicit

Function GetReferences()

    On Error GoTo ErrHandler
    
'    Dim rst As New ADODB.Recordset
'    Dim rstD As New ADODB.Recordset
    
    Dim refLoop As Reference
    Dim accApp As New Access.Application
    
    Dim strAccDb As String
'    Dim strLibDb As String
    Dim strName As String
    Dim strFullName As String
'    Dim strComputerName As String
    
    Dim intBroken As Integer
    

    intBroken = 0
'    strLibDb = vbNullString
    strAccDb = "c:\TestBrokenRef.accdb"
'    strComputerName = GetComputerName
    
'    CurrentProject.Connection.Execute "Delete * from tblMMC_References_Broken"
'    rst.Open "select * from tblMMC_References_Broken", CurrentProject.Connection, adOpenDynamic, adLockOptimistic

    
'    Do While strAccDb <> vbNullString
    
        accApp.OpenCurrentDatabase strAccDb
        
'        rstD.Open "select * from tblMMC_References_Default where strProjectName = '" & strAccDb & "'", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
'        If (rstD.EOF) Then
'            If (MsgBox("The default references for this database" & vbCrLf & "(" & strAccDb & ")" & vbCrLf & " have not yet been created." & vbCrLf & vbCrLf & "Therefore, I may not be able to display the names of all broken references (if any)." & vbCrLf & vbCrLf & "Do you wish to continue?", vbYesNo, "Checking For Broken References") = vbNo) Then
'                GoTo ExitProcedure
'           End If
'        End If
    
        For Each refLoop In accApp.Application.References
            On Error Resume Next
            strFullName = refLoop.FullPath
            If (Err.Number = -2147319779) Then
                strFullName = "Unable to determine due to error: " & Err.Description
                Err.Clear
            End If
           
            strName = refLoop.Name
'            If (Err.Number = -2147319779) Then
'                If (Not rstD.EOF) Then
'                    rstD.Find "GUID='" & refLoop.Guid & "'", , , 1
'                    If (Not rstD.EOF) Then strName = rstD.Fields("strName")
'                End If
'            End If
            
'            rst.AddNew
'            rst.Fields("strComputerName").Value = strComputerName
'            rst.Fields("strProject").Value = strAccDb
'            rst.Fields("strName").Value = strName
'            rst.Fields("strFullPath").Value = strFullName
'            rst.Fields("ysnIsBroken").Value = refLoop.IsBroken
'            rst.Update
            If (refLoop.IsBroken) Then
                intBroken = intBroken + 1
'            Else
'                If (Right(strFullName, 5) = "accdb") Then strLibDb = strFullName
            End If
        Next refLoop
        
        accApp.CloseCurrentDatabase
'        rstD.Close
        
'        If (Len(strLibDb) = 0) Then
'            strAccDb = vbNullString
'        Else
'            strAccDb = strLibDb
'            strLibDb = vbNullString
'        End If
            
    Loop
    

    
    If (intBroken > 0) Then
        If (intBroken = 1) Then MsgBox "There is 1 broken reference" Else MsgBox "There are " & intBroken & " references."
    Else
        MsgBox "There are no broken references."
    End If

ExitProcedure:

    On Error Resume Next
    accApp.CloseCurrentDatabase
 '   rst.Close
 '   Set rst = Nothing

 '   rstD.Close
 '   Set rstD = Nothing
    
    Set accApp = Nothing

    Exit Function
    
ErrHandler:

    If (Err.Number = -2147319779) Then
        Resume Next
    Else
        MsgBox "Error trying to report References." & vbCrLf & vbCrLf & "Error Number: " & Err.Number & vbCrLf & "Error Description: " & Err.Description
        Resume ExitProcedure
    End If
    
End Function

 

[FancyPrairie]

Here's how I got it to work...if anyone is interested.

I set the following condition on each step of my macro: [Application].[UserControl]

By including this condition, the macro step will only run if the database is opened by a user, not through automation

 

[MajP]

Worth a FAQ if one does not exist. This has been asked in the past and recently by seasoned developers.

 

[TheAceMan1]

Howdy FancyPrairie . . .

What if in the begining of your [blue]AutoExec[/blue] you detect & repair any broken references ... before running the heart of the code? The only problem here is detecting and installing the proper version of each broken reference.

[blue]Your Thoughts? . . .[/blue]

See Ya! . . . . . .

Be sure to see thread181-473997 [blue]Worthy Reading![/blue]
Also faq181-2886 [blue]Worthy Reading![/blue]