Error 3251 using ADO & VBA to drop a table!

[Darizotas]

Hello,

I have a MDE file that contains its own model and I am trying to link their
tables to a MDB file. I am trying to do this using ADO 2.8.

The method that I am following is to traverse ADOX.Tables Collection of the
MDE data model and replacing each one with the corresponding table at the MDB
file. But after replacing several tables I found the runtime error 3251 -
OPERATION IS NOT SUPPORTED FOR THIS TYPE OF OBJECT.

This error arises after the following algorithm:

For each table in Tables (from my Catalog)

1. Create a Link (lnk)

2. Tables.Append lnk

3. Catch the error: -2147217857 (Element already exists)

3.1 Remove the table: Tables.Delete table.name

3.2 Catch the error: -2147467259 (Table is involved in a relationship)

3.2.1 Then, I delete all relations that contains as foreign key and when
I ask for the Collection ADOX.Keys it throws the mentioned error. GoTo Step
3.1

Next table

I don't understand why this error happens after replacing several tables
from my model. Can someone tell me if there is something wrong on my
algorithm? Or ADO has any problems with collections??I have also read that
ADO is not prepared to deal with not enforced relationships, is this related
with my problem??

Thanks in advance,

Dario.

PS. Here it is the piece of code that performs the linking. I hope this helps.



Option Explicit

Public Function LinkDataBase(newOrigin As String, force As Boolean) As Boolean
Dim newCat As New ADOX.Catalog
Dim tbl As ADOX.table
'Return value.
LinkDataBase = False
On Error GoTo LinkDataBase_Err
newCat.ActiveConnection = "Provider='Microsoft.Jet.OLEDB.4.0';Data
Source=" & newOrigin

For Each tbl In newCat.Tables
'For each table.
If tbl.Type = "TABLE" Then
If Not LinkTable(newOrigin, tbl.name, force) Then
GoTo LinkDataBase_Exit
End If
End If
Next

LinkDataBase = True
LinkDataBase_Exit:
Set tbl = Nothing
Set newCat = Nothing
Exit Function

LinkDataBase_Err:
'Origin does not exist. Err.Number = '-2147467259'
MiscUtils.ShowError Err.Description
Resume LinkDataBase_Exit
End Function

Public Function LinkTable(origin As String, tbl As String, _
Optional force As Boolean = False) As Boolean
Dim cat As New ADOX.Catalog, tblLink As ADOX.table
On Error GoTo LinkTable_Err

cat.ActiveConnection = CurrentProject.Connection
Set tblLink = CreateLink(cat, origin, tbl)

LinkTable_Exe:
cat.Tables.Append tblLink
LinkTable = True

LinkTable_Exit:
Set cat = Nothing
Set tblLink = Nothing
Exit Function

LinkTable_Err:
'Origin element does not exist.
If Err.Number = -2147217860 Then
MiscUtils.ShowError "Table " & tbl & " does not exist in the origin: " & _
vbCrLf & origin
'Element already exists in the current database.
ElseIf Err.Number = -2147217857 Then
If force Then
RemoveTable tbl, True
Resume LinkTable_Exe
End If
Else
MiscUtils.ShowError Err.Number & " - " & Err.Description
End If
LinkTable = False
Resume LinkTable_Exit
End Function

Private Function CreateLink(catDB As ADOX.Catalog, ByVal origin As String, _
ByVal name As String) As ADOX.table
Dim tblLink As New ADOX.table
With tblLink
.name = name
Set .parentCatalog = catDB
.Properties("Jet OLEDB:Create Link") = True
.Properties("Jet OLEDB:Link Datasource") = origin
.Properties("Jet OLEDB:Remote Table Name") = .name
End With

Set CreateLink = tblLink
Set tblLink = Nothing
End Function

'http://msdn.microsoft.com/library/d...creatingrelationshipsintegrityconstraints.asp
Public Function RemoveTable(ByVal tbl As String, _
Optional force As Boolean = False) As Boolean
Dim cat As New ADOX.Catalog
On Error GoTo RemoveTable_Err
cat.ActiveConnection = CurrentProject.Connection

RemoveTable_Exe:
cat.Tables.Delete tbl
RemoveTable = True

RemoveTable_Exit:
Set cat = Nothing
Exit Function

RemoveTable_Err:
'Nothing to delete, it does not exist in the current model.
If Err.Number = 3265 Then
Resume RemoveTable_Exit
'It is involved in some relationship.
ElseIf Err.Number = -2147467259 Then
If force Then
RemoveRelationships cat, tbl
Resume RemoveTable_Exe
End If
Else
MiscUtils.ShowError Err.Number & " - " & Err.Description
End If
RemoveTable = False
Resume RemoveTable_Exit
End Function

Private Sub RemoveRelationships(cat As ADOX.Catalog, foreignTbl As String)
Dim tbl As ADOX.table
On Error GoTo RemoveRelationships_Err
For Each tbl In cat.Tables
If tbl.Type = "TABLE" Then
If tbl.name <> foreignTbl Then
RemoveRelation tbl, foreignTbl
End If
End If
Next

RemoveRelationships_Exit:
Set tbl = Nothing
Exit Sub

RemoveRelationships_Err:
MiscUtils.ShowError Err.Number & " - " & Err.Description
End Sub

Private Sub RemoveRelation(tbl As ADOX.table, foreignTbl As String)
If foreignTbl = "" Then
Exit Sub
End If

Dim i As Integer
Dim key As ADOX.key, keys As New Collection
On Error GoTo RemoveRelation_Err
For Each key In tbl.keys 'Here starts the problem!! the object keys seems
to disappear
If key.RelatedTable = foreignTbl Then
keys.Add key.name, key.name
End If
Next

Dim kName As Variant
For Each kName In keys
tbl.keys.Delete kName
Next

RemoveRelation_Exit:
Set key = Nothing
Set keys = Nothing
Exit Sub

RemoveRelation_Err:
MiscUtils.ShowError Err.Number & " - " & Err.Description
Resume RemoveRelation_Exit
End Sub

 

[Douglas J Steele]

I'd recommend using DAO for things like this.

DAO was designed specifically for use with Jet databases (i.e. Access
files), whereas ADOX is a generic approach, which implies that you're going
through additional unnecessary levels of abstraction.

 

[Darizotas]

But I have read that ADO is the new supported technology for Microsoft, while
DAO is supposed to be deprecated, that was the reason why I developed it
using ADO.

 

[Douglas J Steele]

It's unfortunate that myth got propagated.

First of all, ADO is dead: it's been replaced by ADO.Net which, despite the
letters ADO being in both, is very different.

Microsoft did remove the default reference to DAO in Access 2000 and 2002,
but saw the error of their ways: it's back in Access 2003.

AFAIK, DAO is alive and well in Access 2007, which should be released
sometime next year.

 

[Darizotas]

Finally somebody has explained me something about these technologies. If you
are telling me that DAO is coming back on next releases, I am wondering why I
am not able to find a reference about methods, objects, etc. like ADO has at
Microsoft Web site.

Therefore, could you tell where could I find a downloadable DAO help
file??Where to find a Reference of the objects, methods, etc.

Thanks in advance,

Darío.
PS. I will try DAO approach.

 

[Douglas J Steele]

DAO should be in the Access help files. While they claimed they were
deprecating DAO, they never removed it from the help.

 

[Darizotas]

Hello again,

I am following your tips and i am moving my code to DAO and removing all my
references to ADO. But I have encountered several errors that I don't
understand quite well, may be you could help me.

1. Suddenly it takes to much time to execute my code: at least 4 seconds to
link 4 tables!!. I don't have any idea why this is happening.

2. The error 3420: Object invalid or no longer set. When the following line
is executed: Set tblLocal = CurrentDb.TableDefs("name")

I attach my code so you can see it better:

Option Compare Database
Option Explicit


'Link the tables contained at the given query. Table names must be located
'at the first column of the query.
'Returns true if it is successful; otherwise, false.
Public Function LinkTables(ByVal sql As String, origin As String) As Boolean
Dim rst As DAO.Recordset
On Error GoTo LinkTables_Err
Set rst = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
While Not rst.EOF
'Stops linking!
If Not LinkTable(origin, rst(0)) Then
LinkTables = False
GoTo LinkTables_Exit
End If
rst.MoveNext
Wend
LinkTables = True

LinkTables_Exit:
If Not rst Is Nothing Then rst.Close
Set rst = Nothing
Exit Function

LinkTables_Err:
'Does not exist the table at the query.
If Err.Number = 3078 Then
MiscUtils.ShowError "The table given at the query does not exist:" &
vbCrLf & _
sql & vbCrLf & _
"Please review the query."
'Does not exist the column given at the query.
ElseIf Err.Number = 3061 Then
MiscUtils.ShowError "The specified columns at the query: " & vbCrLf & _
sql & vbCrLf & _
"don't exist. Please review the query."
Else
MiscUtils.ShowError Err.Number & " - " & Err.Description
End If

LinkTables = False
Resume LinkTables_Exit
End Function

Public Function LinkTable(origin As String, tbl As String) As Boolean
Dim dbOrigin As DAO.Database, dbs As DAO.Database
Dim tblOrigin As DAO.TableDef, tblLocal As DAO.TableDef
On Error GoTo LinkTable_Err
Dim success As Boolean
success = True

'I HAVE COMMENTED THIS LINE, BUT I HAVE TO COPY THIS OBJECT TO AVOID THE
ERROR 3420. AND IT SEEMS TO TAKE TO MUCH TIME, NOT JUST COPYING, ALSO WHEN IT
IS ASKED FOR A TABLE IN THE TABLEDEFS COLLECTION!!
' Set dbs = CurrentDb
Set dbOrigin = DBEngine.OpenDatabase(origin)
Set tblOrigin = dbOrigin.TableDefs(tbl)
'It is linking to a link!!
If tblOrigin.Connect <> "" Then
MiscUtils.ShowError "The table " & tbl & " is already a link to " & _
vbCrLf & origin & vbCrLf & _
"It is not possible to link to it!"

success = False
Else
'Ignores the error!may be this table does not exist in the current model yet.
On Error Resume Next
' Set tblLocal = dbs.TableDefs(tbl)
Set tblLocal = CurrentDb.TableDefs(tbl)
'Enables error-handling again.
On Error GoTo LinkTable_Err
Dim strConn As String
strConn = ";DATABASE=" & origin
If tblLocal Is Nothing Then
' Set tblLocal = dbs.CreateTableDef(tbl, 0, tbl, strConn)
' dbs.TableDefs.Append tblLocal
Set tblLocal = CurrentDb.CreateTableDef(tbl, 0, tbl, strConn)
CurrentDb.TableDefs.Append tblLocal
Else
'Refreshes the link!
If tblLocal.Connect <> "" Then
tblLocal.Connect = strConn
tblLocal.RefreshLink
Else
'Drops the table.
If BorraTabla(tbl, True) Then
Set tblLocal = CurrentDb.CreateTableDef(tbl, 0, tbl, strConn)
CurrentDb.TableDefs.Append tblLocal
' Set tblLocal = dbs.CreateTableDef(tbl, 0, tbl, strConn)
' dbs.TableDefs.Append tblLocal
Else
MiscUtils.ShowError "Table " & tbl & " could not be linked."
success = False
End If
End If
End If
End If

LinkTable = success

LinkTable_Exit:
If Not dbOrigin Is Nothing Then dbOrigin.Close
Set dbOrigin = Nothing
Set tblOrigin = Nothing
If Not dbs Is Nothing Then dbs.Close
Set dbs = Nothing
Set tblLocal = Nothing
Exit Function

LinkTable_Err:
'Origin element does not exist in the origin database.
If Err.Number = 3265 Then
MiscUtils.ShowError "La tabla " & tbl & " no existe en la base de datos:
" & _
vbCrLf & origin
Else
MiscUtils.ShowError Err.Number & " - " & Err.Description
End If
LinkTable = False
Resume LinkTable_Exit
End Function


Should both errors be related because I am not using well the connections to
the database??

Thank you for your patience!

Dario.

 

[Alex Dybenko]

Hi Jamie,

did you see the date this article published? <g>

Intermediate Microsoft Jet SQL for Access 2000
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnacc2k/html/acintsql.asp

Personally - I have a lot of experience in both DAO and ADO, and must admit
that DAO in Access - is a best choice

--
Best regards,
___________
Alex Dybenko (MVP)
http://alexdyb.blogspot.com
http://www.PointLtd.com

 

[Alex Dybenko]

Hi,

Can we agree that DAO vs ADO is a choice, rather than start another
debate about which is 'best'?

of course, best thing - that we have this choice. If you think, that ADO
better fits in Access - I have no objections, but if somebody ask me - what
is the best option from my experience - I will say DAO.
Fortunately Microsoft also understand this and made DAO default reference as
Doug mentioned

--
Best regards,
___________
Alex Dybenko (MVP)
http://alexdyb.blogspot.com
http://www.PointLtd.com

 

[Alex Dybenko]

ok, *why* DAO is better for Access(IMHO <g>):
if you need to manipulate data using recordsets - DAO has more
possibilities/options
if you run queries - DAO has better error handling
if you modify data structure - with DAO you can do everything (well almost
everything), in case of ADO you can use ADOX - but have to use late
bindings, not so convenient. or DDL queries.

DAO is native for Jet databases, ADO was built as universal library

Where ADO is better - disconnected recordsets, mixed database sources,
saving/loading from XML,etc

actually i have a proc to copy DAO recordset to ADO, which i use, when i
come to such kind of tasks

does it make sense?

Remember, that we are talking about Access, for com object, which resides on
MTS server, i will certainly choose ADO

--
Best regards,
___________
Alex Dybenko (MVP)
http://alexdyb.blogspot.com
http://www.PointLtd.com