FixConnections "MyServer", "MyDatabase"and hitting Enter (where, of course, you replace MyServer and MyDatabase by whatever's appropriate). Note that I'm using DAO (Data Access Objects) to make this work. Access 2000 or 2002 use ADO (ActiveX Data Objects) by default: you'll have to add a reference to DAO in order to be able to use this code. To do this, open any code module, then select Tools | References from the menu bar. Scroll through the list of available references until you find the one for Microsoft DAO 3.6 Object Library, and select it. Note also that this is a revised version of the code. There was a problem with the previous version handling certain cases of indexes in the linked table. I've tested this as thoroughly as I can (given I wasn't having those problems), and I think it'll work now. However, I've put some specific error checking when there's a problem with the indexes. If you're posting a problem to the newsgroup, please indicate exactly what's shown in that error message. And I should point out that you should use this code on a copy of your database. If you run into a problem, throw away that copy of the database and make a new one before you try running the code again. It's entirely possible that there might be problems if the code has run partway through, but not completed successfully.
'***************** Code Start **************
Type TableDetails
TableName As String
SourceTableName As String
Attributes As Long
IndexSQL As String
Description As Variant
End Type
Sub FixConnections(ServerName As String, DatabaseName As String)
' This code was originally written by
' Doug Steele, MVP djsteele@gmail.com
' You are free to use it in any application
' provided the copyright notice is left unchanged.
'
' Description: This subroutine looks for any TableDef objects in the
' database which have a connection string, and changes the
' Connect property of those TableDef objects to use a
' DSN-less connection.
' This specific routine connects to the specified SQL Server
' database on a specified server. It assumes trusted connection.
'
' Inputs: ServerName: Name of the SQL Server server (string)
' DatabaseName: Name of the database on that server (string)
'
On Error GoTo Err_FixConnections
Dim dbCurrent As DAO.Database
Dim prpCurrent As DAO.Property
Dim tdfCurrent As DAO.TableDef
Dim intLoop As Integer
Dim intToChange As Integer
Dim strDescription As String
Dim typNewTables() As TableDetails
intToChange = 0
Set dbCurrent = DBEngine.Workspaces(0).Databases(0)
' Build a list of all of the connected TableDefs and
' the tables to which they're connected.
For Each tdfCurrent In dbCurrent.TableDefs
If Len(tdfCurrent.Connect) > 0 Then
ReDim Preserve typNewTables(0 To intToChange)
typNewTables(intToChange).Attributes = tdfCurrent.Attributes
typNewTables(intToChange).TableName = tdfCurrent.Name
typNewTables(intToChange).SourceTableName = tdfCurrent.SourceTableName
typNewTables(intToChange).IndexSQL = GenerateIndexSQL(tdfCurrent.Name)
typNewTables(intToChange).Description = Null
typNewTables(intToChange).Description = tdfCurrent.Properties("Description")
intToChange = intToChange + 1
End If
Next
' Loop through all of the linked tables we found
For intLoop = 0 To (intToChange - 1)
' Delete the existing TableDef object
dbCurrent.TableDefs.Delete typNewTables(intLoop).TableName
' Create a new TableDef object, using the DSN-less connection
Set tdfCurrent = dbCurrent.CreateTableDef(typNewTables(intLoop).TableName)
tdfCurrent.Connect = "ODBC;DRIVER={sql server};DATABASE=" & _
DatabaseName & ";SERVER=" & ServerName & _
";Trusted_Connection=Yes;"
tdfCurrent.SourceTableName = typNewTables(intLoop).SourceTableName
dbCurrent.TableDefs.Append tdfCurrent
' Where it existed, add the Description property to the new table.
If IsNull(typNewTables(intLoop).Description) = False Then
strDescription = CStr(typNewTables(intLoop).Description)
Set prpCurrent = tdfCurrent.CreateProperty("Description", dbText, strDescription)
tdfCurrent.Properties.Append prpCurrent
End If
' Where it existed, create the __UniqueIndex index on the new table.
If Len(typNewTables(intLoop).IndexSQL) > 0 Then
dbCurrent.Execute typNewTables(intLoop).IndexSQL, dbFailOnError
End If
Next
End_FixConnections:
Set tdfCurrent = Nothing
Set dbCurrent = Nothing
Exit Sub
Err_FixConnections:
' Specific error trapping added for Error 3291
' (Syntax error in CREATE INDEX statement.), since that's what many
' people were encountering with the old code.
' Also added error trapping for Error 3270 (Property Not Found.)
' to handle tables which don't have a description.
Select Case Err.Number
Case 3270
Resume Next
Case 3291
MsgBox "Problem creating the Index using" & vbCrLf & _
typNewTables(intLoop).IndexSQL, _
vbOKOnly + vbCritical, "Fix Connections"
Resume End_FixConnections
Case Else
MsgBox Err.Description & " (" & Err.Number & ") encountered", _
vbOKOnly + vbCritical, "Fix Connections"
Resume End_FixConnections
End Select
End Sub
Function GenerateIndexSQL(TableName As String) As String
' This code was originally written by
' Doug Steele, MVP djsteele@gmail.com
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Description: Linked Tables should have an index __uniqueindex.
' This function looks for that index in a given
' table and creates an SQL statement which can
' recreate that index.
' (There appears to be no other way to do this!)
' If no such index exists, the function returns an
' empty string ("").
'
' Inputs: TableDefObject: Reference to a Table (TableDef object)
'
' Returns: An SQL string (or an empty string)
'
On Error GoTo Err_GenerateIndexSQL
Dim dbCurr As DAO.Database
Dim idxCurr As DAO.Index
Dim fldCurr As DAO.Field
Dim strSQL As String
Dim tdfCurr As DAO.TableDef
Set dbCurr = CurrentDb()
Set tdfCurr = dbCurr.TableDefs(TableName)
If tdfCurr.Indexes.Count > 0 Then
' Ensure that there's actually an index named
' "__UnigueIndex" in the table
On Error Resume Next
Set idxCurr = tdfCurr.Indexes("__uniqueindex")
If Err.Number = 0 Then
On Error GoTo Err_GenerateIndexSQL
' Loop through all of the fields in the index,
' adding them to the SQL statement
If idxCurr.Fields.Count > 0 Then
strSQL = "CREATE INDEX __UniqueIndex ON [" & TableName & "] ("
For Each fldCurr In idxCurr.Fields
strSQL = strSQL & "[" & fldCurr.Name & "], "
Next
' Remove the trailing comma and space
strSQL = Left$(strSQL, Len(strSQL) - 2) & ")"
End If
End If
End If
End_GenerateIndexSQL:
Set fldCurr = Nothing
Set tdfCurr = Nothing
Set dbCurr = Nothing
GenerateIndexSQL = strSQL
Exit Function
Err_GenerateIndexSQL:
' Error number 3265 is "Not found in this collection
' (in other words, either the tablename is invalid, or
' it doesn't have an index named __uniqueindex)
If Err.Number <> 3265 Then
MsgBox Err.Description & " (" & Err.Number & ") encountered", _
vbOKOnly + vbCritical, "Generate Index SQL"
End If
Resume End_GenerateIndexSQL
End Function
'************** Code End *****************
Addendum: I received e-mail about this from Bryan Beissel. Bryan indicated that he didn't want to use Trusted Connection. Based on information at Carl Prothman's site, he modified the routine to accept an id and password, and tried to use the following connection string:
tdfCurrent.Connect = "ODBC;DRIVER={sql server};DATABASE=" & _
DatabaseName & ";SERVER=" & ServerName & _
";Uid=" & myUserName & _
";Pwd=" & myPassword & ";"
However, Access wouldn't save the information. Bryan came across an article that indicated that
you needed to set tdfCurrent.Attributes = DB_ATTACHSAVEPWD in order to have Access save the
user id and password information for each table.
I haven't tried this myself (as I always use trusted connection). On first glance, it would seem to be a questionable idea, as you'd end up store the User ID and password in plain text in the Connect property. However, if that doesn't bother you, go for it!
Addendum 2: Bill Murphy pointed out in microsoft.public.access.modulesdaovba that my code wasn't propagating the Description property if one existed. D'oh!
The code above has been modified to allow for this. Note that the Description property doesn't actually exist unless a description has been added. That means that if you refer to the Description property and one doesn't exist, you'll end up with an Error (3270: Property not found.). To get around this, I'm trapping for error 3270 in my error handling in the routine FixConnections. I'm storing the Description in a Variant field, so that I can actually save a Null if no description exists. Note that I have to add the newly created TableDef object to the TableDefs collection before I can add the description. (I certainly didn't expect that!)
Addendum 3: Someone (I'm afraid I've forgotten whom) had a scenario where some of the tables were linked to another Jet database, and others were linked using ODBC to SQL Server. The code above makes the simplifying assumption that all tables are linked to the same backend. If you only need to relink some of the tables, you'll have to come up with your own approach to determining which tables need to be relinked.For instance, if all of your ODBC-linked tables need to be changed, you can rewrite the section of code that populates typNewTables, such as:
' Build a list of all of the connected TableDefs and
' the tables to which they're connected.
For Each tdfCurrent In dbCurrent.TableDefs
If Len(tdfCurrent.Connect) > 0 Then
If Left$(tdfCurrent.Connect, 5) = "ODBC;" Then
ReDim Preserve typNewTables(0 To intToChange)
typNewTables(intToChange).Attributes = tdfCurrent.Attributes
typNewTables(intToChange).TableName = tdfCurrent.Name
typNewTables(intToChange).SourceTableName = tdfCurrent.SourceTableName
typNewTables(intToChange).IndexSQL = GenerateIndexSQL(tdfCurrent.Name)
typNewTables(intToChange).Description = Null
typNewTables(intToChange).Description = tdfCurrent.Properties("Description")
intToChange = intToChange + 1
End If
End If
Next
Addendum 4: While this doesn't directly affect what's discussed on this page, if you're using Vista, rather than use
tdfCurrent.Connect = "ODBC;DRIVER={sql server};DATABASE=" & _
DatabaseName & ";SERVER=" & ServerName & _
";Trusted_Connection=Yes;"
you should use
tdfCurrent.Connect = "ODBC;DRIVER={SQL Native Client};DATABASE=" & _
DatabaseName & ";SERVER=" & ServerName & _
";Trusted_Connection=Yes;"
See the Vista, ODBC and SQL Server 2005 thread at Google Groups.
Addendum 5: George Hepworth pointed out to me that if the connection string you provide is incorrect (eg. the Server is mistyped, or the database doesn't exist), you're going to end up deleting all your linked tables. For this reason, you might consider storing the details of the linked tables in a local table (or in the registry or in an INI file).
Access Home|
|
This page is maintained by
Last Updated: 22nd December, 2009 |