CODEWITHSUNDEEP
ms-accessvba
Jorge
Jorge

Reputation: 358

VBA - Access database table collection

I have a sub which creates a new collection of Access database object linked tabledef. The sub works 1/2 the time without error if code is not reset (just hitting F5), but always works if first reset. However when calling this sub in another module it only works 1/2 of the time again. Any ideas why this only works only 1/2 the time when called in another sub?

Public Tables As New Collection
Sub SET_VAR()
'##############################################################
'# 1. CREATE PUBLIC COLLECTION OF LINKED TABLES IN DB
'##############################################################
On Error GoTo handlr:
   Dim tdf As TableDef
   Dim db As Database
   Set db = DBEngine(0)(0)
   For Each tdf In db.TableDefs
      If Left(tdf.Connect, 5) = "ODBC;" Then
         Tables.Add tdf, Chr(34) & tdf.Name & Chr(34)
      End If
   Next tdf
   MsgBox "Success. Linked tables public collection created!"
   Exit Sub
handlr:
   MsgBox "Error. Linked tables not added to public collection!"
   End
End Sub

enter image description here

This is the error Access gives me:

"457 This key is already associated with an element of this collection"

Upvotes: 1

Views: 949

Answers (2)

HansUp
HansUp

Reputation: 97101

Change the first line to Public Tables As Collection Then, in SET_VAR(), add Set Tables = New Collection

Public Tables As Collection
Sub SET_VAR()
On Error GoTo handlr:
   Dim tdf As TableDef
   Dim db As Database
   Set Tables = New Collection
   Set db = DBEngine(0)(0)
   For Each tdf In db.TableDefs
      If Left(tdf.Connect, 5) = "ODBC;" Then
         Tables.Add tdf, Chr(34) & tdf.Name & Chr(34)
      End If
   Next tdf
   MsgBox "Success. Linked tables public collection created!"
   Exit Sub
handlr:
   MsgBox "Error. Linked tables not added to public collection!" & _
        vbCrLf & "(error #" & err.Number & " :" & err.Description & ")"
End Sub

Since you will then start with an empty Collection each time the procedure runs, those changes should eliminate the duplicate key problem.

I also added the error number and description to the MsgBox text. If you prefer not to show those details to the users, Debug.Print them to the Immediate window. When your code encounters an error, you need to understand why it happened.

Upvotes: 1

Gustav
Gustav

Reputation: 55831

You miss a refresh:

Set db = DBEngine(0)(0)
For Each tdf In db.TableDefs
    If Left(tdf.Connect, 5) = "ODBC;" Then
        Tables.Add tdf, Chr(34) & tdf.Name & Chr(34)
    End If
Next tdf
db.TableDefs.Refresh

Upvotes: 1

Related Questions