Find Databases with Linked tables

[AndyV]

The network guys where I work are changing the directory structure of the main file server. I need to write some vba that loops through the directory structure, and finds access databases containing linked tables. I have written the looping through the directory structure bit, but is there a quick way I can find out whether the database contains linked tables. I also have to try to find excel files with links to other sources as well. Any ideas?

Andy

 

[gemma-the-husky]

?

linked tables will show in the table list with unusual symbols, depending on the type of table (eg SQL, Jet, DBase etc)

-----------
sorry - read it again

I doubt if you can do this without opening the DBS.


You can use a table linker utility of course

have a module that examines any given table you know to be a linked table - if the link is valid then no probelm

if not, offer a file browser to locate the backend, and relink all the tables to it.

 

[AndyV]

As I won't be physically looking at the databases, I won't see any symbols. I will probably kick the process of overnight, so do I have to get the vba to open each of the databases, loop through all of the tables and then close the database again?

 

[gemma-the-husky]

not sure how to open another dbs from code.

As I say, all my dbs's have inbuilt stuff to check correct linkage of tables, and reconnect in the event that there are problems - but obviously correct linkage is critical, and I would prefer to make sure its Ok

how many dbs's are there?

 

[AndyV]

I am not bothered about mine, it is the other databases knocking about that will pose the problem. I have done a preliminary check and there are about 600 db's on the fileserver.

 

[gemma-the-husky]

this code fragment will locate linked tables
you need to rebuild the connect string and refresh the link

if the links are not jet, (particularly if they are SQL links) then its more awkward - if you use ODBC sources, you may need to rebuild all the DSN links

note that this may apply to apps other than Access - although you may not be bothered about these

dim tdf as tabledef
dim dbs as database

set dbs=currentdb
for each tdf in dbs.tabledefs
   if tdf.connect<>vbnullstring then
   'this is a linked table
   end if
next

 

[allan57]

Create the following two tables:-

table 1: Application_Database_Locations

Fields: txtDatabase_Path
txtDatabase_Name

table 2: Application_Table_Connection_Location

Fields: txtDatabase_Path
txtDatabase_Name
txtTable_Name
txtTable_Connection

Copy the following two functions into your database and then call then

GetDatabaseLocations
GetDatabaseTableLocation

Public Function GetDatabaseTableLocation()

Dim wsp As Workspace
    
Dim dbsCurrent As Database
Dim dbsDatabases As Database

Dim rstStoreTableLocation As Recordset
Dim rstDatabaseLocations As Recordset

Dim tdf As TableDef
    
Dim fldDatabasePath As Field
Dim fldDatabaseName As Field
    
On Error Resume Next
    
    Set dbsCurrent = CurrentDb
    
    DoCmd.RunSQL ("DELETE Application_Table_Connection_Location.* FROM Application_Table_Connection_Location;")
    
    Set rstDatabaseLocations = dbsCurrent.OpenRecordset("SELECT Application_Database_Locations.txtDatabase_Path, Application_Database_Locations.txtDatabase_Name " & _
                                                        "FROM Application_Database_Locations;")

    Set fldDatabasePath = rstDatabaseLocations!txtDatabase_Path
    Set fldDatabaseName = rstDatabaseLocations!txtDatabase_Name
        
    Set wsp = DBEngine.Workspaces(0)
    
    While Not rstDatabaseLocations.EOF
    
        Set dbsDatabases = wsp.OpenDatabase(rstDatabaseLocations!txtDatabase_Path & rstDatabaseLocations!txtDatabase_Name, , True)
        
        dbsDatabases.TableDefs.Refresh
        
        Set rstStoreTableLocation = dbsCurrent.OpenRecordset("SELECT Application_Table_Connection_Location.* " & _
                                                             "FROM Application_Table_Connection_Location;")
    
        For Each tdf In dbsDatabases.TableDefs
            
            With tdf
                
                If Len(.Connect) > 0 Then
                                    
                    rstStoreTableLocation.AddNew
                        
                        rstStoreTableLocation!txtDatabase_Path = fldDatabasePath
                        rstStoreTableLocation!txtDatabase_Name = fldDatabaseName
                        rstStoreTableLocation!txtTable_Name = .Name
                        rstStoreTableLocation!txtTable_Connection = .Connect
                
                    rstStoreTableLocation.Update
                
                Else
                
                    rstStoreTableLocation.AddNew
                        
                        rstStoreTableLocation!txtDatabase_Path = rstDatabaseLocations!txtDatabase_Path
                        rstStoreTableLocation!txtDatabase_Name = rstDatabaseLocations!txtDatabase_Name
                        rstStoreTableLocation!txtTable_Name = .Name
                        rstStoreTableLocation!txtTable_Connection = "Local"
                
                    rstStoreTableLocation.Update
                
                End If
            
            End With
        
        Next 'Each tdf In dbsDatabases.TableDefs
    
        rstDatabaseLocations.MoveNext
    
    Wend 'Not rstDatabaseLocations.EOF
    
    Set tdf = Nothing
    
    rstStoreTableLocation.Close
    dbsDatabases.Close
    dbsCurrent.Close
    
    Set rstStoreTableLocation = Nothing
    Set dbsDatabases = Nothing
    Set dbsCurrent = Nothing
    
End Function

Public Function GetDatabaseLocations()

Dim varPath As Variant
Dim varDirName As Variant
Dim varFileName As Variant

Dim strDirectoryName(255) As String
Dim strFileName As String

Dim intDirectoryCounter As Integer
Dim intNumberOfDirsFound As Integer

On Error Resume Next

    DoCmd.RunSQL ("DELETE Application_Database_Locations.* FROM Application_Database_Locations;")

    'enter the root path where you wish to start the search from
    varPath = "n:\access_development\"
    
    varDirName = Dir(varPath, vbDirectory)
    
    intDirectoryCounter = 1
    
    Do While varDirName <> ""
    
        If varDirName <> "." And varDirName <> ".." Then
    
            If (GetAttr(varPath & varDirName) And vbDirectory) = vbDirectory Then
                
                If Left(varDirName, 1) <> "1" Then
                
                    strDirectoryName(intDirectoryCounter) = varPath & varDirName
                    
                    intDirectoryCounter = intDirectoryCounter + 1
                
                End If
            
            End If
                  
        End If
                   
    varDirName = Dir
                   
    Loop
           
    intNumberOfDirsFound = intDirectoryCounter - 1
           
    For intDirectoryCounter = 1 To intNumberOfDirsFound
           
        varFileName = Dir(strDirectoryName(intDirectoryCounter) & "\*.mdb")
        
        Do While varFileName <> ""
        
            DoCmd.RunSQL ("INSERT INTO Application_Database_Locations ( txtDatabase_Path, txtDatabase_Name ) " & _
                              "SELECT '" & strDirectoryName(intDirectoryCounter) & "\', '" & varFileName & "';")
    
        varFileName = Dir
    
        Loop
    
    Next
           
End Function