By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
435,030 Members | 1,997 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 435,030 IT Pros & Developers. It's quick & easy.

Modify DAO.Tabledef

P: n/a
I am using code provided by Mr. Steele that allows for my MDB to
dynamically connect to remote SQL server databases. The code works
fine as follows:

Type TableDetails
TableName As String
SourceTableName As String
Attributes As Long
IndexSQL As String
End Type

Sub FixConnections(ServerName As String, DatabaseName As String)
' This code was originally written by
' Doug Steele, MVP dj******@canada.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 intLoop As Integer
Dim intToChange As Integer
Dim tdfCurrent As DAO.TableDef
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)
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
'Press Ctrl G and type in -->> FixConnections "fulms255\fulmfg",
"ABBAccuray"
Set tdfCurrent =
dbCurrent.CreateTableDef(typNewTables(intLoop).Tab leName)
tdfCurrent.Connect = "ODBC;Driver={SQL Server}" & _
";Server=" & ServerName & _
";Database=" & DatabaseName & _
";Uid=no3pm;Pwd=dmacs"
tdfCurrent.SourceTableName = typNewTables(intLoop).SourceTableName
dbCurrent.TableDefs.Append tdfCurrent

' 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.
If Err.Number = 3291 Then
MsgBox "Problem creating the Index using" & vbCrLf & _
typNewTables(intLoop).IndexSQL, _
vbOKOnly + vbCritical, "Fix Connections"
Else
MsgBox Err.Description & " (" & Err.Number & ") encountered", _
vbOKOnly + vbCritical, "Fix Connections"
End If
Resume End_FixConnections

End Sub

Function GenerateIndexSQL(TableName As String) As String
' This code was originally written by
' Doug Steele, MVP dj******@canada.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
As you can see from the above the code requires you to supply your
server name and database.

Here's my problem:

I am attempting to connect to two different databases on the SAME
server. I want the code to be able to connect to both of these
databases. It was suggested to me that I create a table where I can
define the database, tablenames, etc. I have created a table called
tbl_DatabaseTables that has the following fields:

TableName
DatebaseName
Username
Password
ServerName

Within the table I defined the various tables, databases etc.

I am uncertain how I would need to modify this code so that the
tdfCurrent are looked up in the MDB table called tbl_DatabaseTables.

Can anyone help me with this ?

Thanks!!
Nov 13 '05 #1
Share this Question
Share on Google+
4 Replies


P: n/a
jr*****@yahoo.com (John) wrote in message news:<c1**************************@posting.google. com>...
I am using code provided by Mr. Steele that allows for my MDB to
dynamically connect to remote SQL server databases. The code works
fine as follows:

Type TableDetails
TableName As String
SourceTableName As String
Attributes As Long
IndexSQL As String
End Type

Sub FixConnections(ServerName As String, DatabaseName As String)
' This code was originally written by
' Doug Steele, MVP dj******@canada.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 intLoop As Integer
Dim intToChange As Integer
Dim tdfCurrent As DAO.TableDef
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)
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
'Press Ctrl G and type in -->> FixConnections "fulms255\fulmfg",
"ABBAccuray"
Set tdfCurrent =
dbCurrent.CreateTableDef(typNewTables(intLoop).Tab leName)
tdfCurrent.Connect = "ODBC;Driver={SQL Server}" & _
";Server=" & ServerName & _
";Database=" & DatabaseName & _
";Uid=no3pm;Pwd=dmacs"
tdfCurrent.SourceTableName = typNewTables(intLoop).SourceTableName
dbCurrent.TableDefs.Append tdfCurrent

' 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.
If Err.Number = 3291 Then
MsgBox "Problem creating the Index using" & vbCrLf & _
typNewTables(intLoop).IndexSQL, _
vbOKOnly + vbCritical, "Fix Connections"
Else
MsgBox Err.Description & " (" & Err.Number & ") encountered", _
vbOKOnly + vbCritical, "Fix Connections"
End If
Resume End_FixConnections

End Sub

Function GenerateIndexSQL(TableName As String) As String
' This code was originally written by
' Doug Steele, MVP dj******@canada.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
As you can see from the above the code requires you to supply your
server name and database.

Here's my problem:

I am attempting to connect to two different databases on the SAME
server. I want the code to be able to connect to both of these
databases. It was suggested to me that I create a table where I can
define the database, tablenames, etc. I have created a table called
tbl_DatabaseTables that has the following fields:

TableName
DatebaseName
Username
Password
ServerName

Within the table I defined the various tables, databases etc.

I am uncertain how I would need to modify this code so that the
tdfCurrent are looked up in the MDB table called tbl_DatabaseTables.

Can anyone help me with this ?

Thanks!!


Instead of looking at the tables with the .Connect property, just read
from your table. Open a recordset based on the table and process.
Nov 13 '05 #2

P: n/a
pi********@hotmail.com (Pieter Linden) wrote in message news:<bf**************************@posting.google. com>...
jr*****@yahoo.com (John) wrote in message news:<c1**************************@posting.google. com>...
I am using code provided by Mr. Steele that allows for my MDB to
dynamically connect to remote SQL server databases. The code works
fine as follows:

Type TableDetails
TableName As String
SourceTableName As String
Attributes As Long
IndexSQL As String
End Type

Sub FixConnections(ServerName As String, DatabaseName As String)
' This code was originally written by
' Doug Steele, MVP dj******@canada.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 intLoop As Integer
Dim intToChange As Integer
Dim tdfCurrent As DAO.TableDef
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)
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
'Press Ctrl G and type in -->> FixConnections "fulms255\fulmfg",
"ABBAccuray"
Set tdfCurrent =
dbCurrent.CreateTableDef(typNewTables(intLoop).Tab leName)
tdfCurrent.Connect = "ODBC;Driver={SQL Server}" & _
";Server=" & ServerName & _
";Database=" & DatabaseName & _
";Uid=no3pm;Pwd=dmacs"
tdfCurrent.SourceTableName = typNewTables(intLoop).SourceTableName
dbCurrent.TableDefs.Append tdfCurrent

' 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.
If Err.Number = 3291 Then
MsgBox "Problem creating the Index using" & vbCrLf & _
typNewTables(intLoop).IndexSQL, _
vbOKOnly + vbCritical, "Fix Connections"
Else
MsgBox Err.Description & " (" & Err.Number & ") encountered", _
vbOKOnly + vbCritical, "Fix Connections"
End If
Resume End_FixConnections

End Sub

Function GenerateIndexSQL(TableName As String) As String
' This code was originally written by
' Doug Steele, MVP dj******@canada.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
As you can see from the above the code requires you to supply your
server name and database.

Here's my problem:

I am attempting to connect to two different databases on the SAME
server. I want the code to be able to connect to both of these
databases. It was suggested to me that I create a table where I can
define the database, tablenames, etc. I have created a table called
tbl_DatabaseTables that has the following fields:

TableName
DatebaseName
Username
Password
ServerName

Within the table I defined the various tables, databases etc.

I am uncertain how I would need to modify this code so that the
tdfCurrent are looked up in the MDB table called tbl_DatabaseTables.

Can anyone help me with this ?

Thanks!!


Instead of looking at the tables with the .Connect property, just read
from your table. Open a recordset based on the table and process.


Can you post some sample code on how I would approach this? Sorry for
my ignorance, but I am somewhat new to VBA and Access.... Thanks.
Nov 13 '05 #3

P: n/a
John: The answer will differ if you're connecting to tables or views in SQL
Server (since with views, you need to specify a primary key, whereas you
inherit the primary key with tables). If you're using tables, or don't care
if it's read-only, the simplest approach would be the following untested
air-code:

Sub FixConnections()
On Error GoTo Err_FixConnections

Dim dbCurrent As DAO.Database
Dim rsCurrent As DAO.Recordset
Dim tdfCurrent As DAO.TableDef

Set dbCurrent = DBEngine.Workspaces(0).Databases(0)
Set rsCurrent = dbCurrent.OpenRecordset("tbl_DatabaseTables")
With rsCurrent
Do While .EOF = False
dbCurrent.TableDefs.Delete !TableName

Set tdfCurrent = dbCurrent.CreateTableDef(!TableName)
tdfCurrent.Connect = "ODBC;Driver={SQL Server}" & _
";Server=" & !ServerName & _
";Database=" & !DatabaseName & _
";Uid=" & !Username & _
";Pwd=" & !Password

tdfCurrent.SourceTableName = !TableName
dbCurrent.TableDefs.Append tdfCurrent

.MoveNext
Loop
End With

End_FixConnections:
On Error Resume Next
rsCurrent.Close
Set rsCurrent = Nothing
Set tdfCurrent = Nothing
Set dbCurrent = Nothing
Exit Sub

Err_FixConnections:
MsgBox Err.Description & " (" & Err.Number & ") encountered", _
vbOKOnly + vbCritical, "Fix Connections"
Resume End_FixConnections

End Sub

If you do need to worry about recreating the index, the easiest way would be
to determine the appropriate SQL to do it, and store it in
tbl_DatabaseTables.

--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)

"John" <jr*****@yahoo.com> wrote in message
news:c1*************************@posting.google.co m...
Can you post some sample code on how I would approach this? Sorry for
my ignorance, but I am somewhat new to VBA and Access.... Thanks.

Nov 13 '05 #4

P: n/a
jr*****@yahoo.com (John) wrote in message news:<c1**************************@posting.google. com>...

After reviewing your code and spending a great deal of time
understanding what is taking place here, I think I finally understand.
It works!! Thanks!

John

I am using code provided by Mr. Steele that allows for my MDB to
dynamically connect to remote SQL server databases. The code works
fine as follows:

Type TableDetails
TableName As String
SourceTableName As String
Attributes As Long
IndexSQL As String
End Type

Sub FixConnections(ServerName As String, DatabaseName As String)
' This code was originally written by
' Doug Steele, MVP dj******@canada.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 intLoop As Integer
Dim intToChange As Integer
Dim tdfCurrent As DAO.TableDef
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)
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
'Press Ctrl G and type in -->> FixConnections "fulms255\fulmfg",
"ABBAccuray"
Set tdfCurrent =
dbCurrent.CreateTableDef(typNewTables(intLoop).Tab leName)
tdfCurrent.Connect = "ODBC;Driver={SQL Server}" & _
";Server=" & ServerName & _
";Database=" & DatabaseName & _
";Uid=no3pm;Pwd=dmacs"
tdfCurrent.SourceTableName = typNewTables(intLoop).SourceTableName
dbCurrent.TableDefs.Append tdfCurrent

' 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.
If Err.Number = 3291 Then
MsgBox "Problem creating the Index using" & vbCrLf & _
typNewTables(intLoop).IndexSQL, _
vbOKOnly + vbCritical, "Fix Connections"
Else
MsgBox Err.Description & " (" & Err.Number & ") encountered", _
vbOKOnly + vbCritical, "Fix Connections"
End If
Resume End_FixConnections

End Sub

Function GenerateIndexSQL(TableName As String) As String
' This code was originally written by
' Doug Steele, MVP dj******@canada.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
As you can see from the above the code requires you to supply your
server name and database.

Here's my problem:

I am attempting to connect to two different databases on the SAME
server. I want the code to be able to connect to both of these
databases. It was suggested to me that I create a table where I can
define the database, tablenames, etc. I have created a table called
tbl_DatabaseTables that has the following fields:

TableName
DatebaseName
Username
Password
ServerName

Within the table I defined the various tables, databases etc.

I am uncertain how I would need to modify this code so that the
tdfCurrent are looked up in the MDB table called tbl_DatabaseTables.

Can anyone help me with this ?

Thanks!!

Nov 13 '05 #5

This discussion thread is closed

Replies have been disabled for this discussion.