Creating a new primary key field with DAO

[traveler]

I have an app which I originally developed using macros, not VBA. As a
result of literally everyone telling me that I need to convert it to VBA I am
doing that one module at a time using the built-in macro converter and then
going through the code to optimize it. In the process I have learned that
several of my tables were not designed the best as they have no autonumber
primary key field. So, I want to create a new filed in the tables and make
it an autonumber primary key field.

Doing this from the design view of the tables is a snap. The problem is
that I have this app being used in several states by users who are not able
to make the necessary changes so I need to write a conversion routine to
handle this.

Since I am fairly new to VBA (though I do have many years of operating
system programming experience in years past) and even newer to DAO, I have
read several thousand pages of books and have searched on-line for solutions.
I have manages to borrow some code from others who are doing similar things
but the code doesn't work and I don't know enough to figure out why.

Here is the code that I am using. When I execute it it executes to
completion but it doesn't appear to produce any change in the table. I have
used a simple example here with a table called "tblUser" with a single field
called "user" which is currently defined as a text field and is currently the
primary key. I want to have two fields in the table, the first called "ID"
and the other called "User".

Can one of you wizzards look this over and give me a suggestion as to what I
am doing wrong?

TIA



Private Sub Make_tblUsersPKey()
Dim dbs As Database
Dim tdf As DAO.TableDef
Dim idx As DAO.Index
Dim idxFld As Variant
Dim varPKey As Variant

Set dbs = CurrentDb
On Error Resume Next
Set tdf = dbs.TableDefs("tblUsers")

'Check if a Primary Key exists.
'If so, delete it.
varPKey = GetPrimaryKey(tdf)
If Not IsNull(varPKey) Then
tdf.Indexes.Delete varPKey
End If

'Create a new primary key
Set idx = tdf.CreateIndex("PrimaryKey")
idx.Primary = True
idx.Required = True
idx.Unique = True

'Create the new Index field
idxFld = "UserID"
Set idxFld = idx.CreateField(idxFld)
idx.Fields.Append idxFld

'Append the index to the Indexes collection
tdf.Indexes.Append idx

'Refresh the Indexes collection
tdf.Indexes.Refresh

Set idx = Nothing
Set tdf = Nothing
Set dbs = Nothing

End Sub

Public Function GetPrimaryKey(tdf As DAO.TableDef) As Variant
'Determind if the specified Primary Key exists
Dim idx As Variant
For Each idx In tdf.Indexes
If idx.Primary Then
'If a primary Key exists, return its name
GetPrimaryKey = idx.Name
GoTo GetPrimaryKey_Exit
End If
Next idx

'If no Primary Key exists, return Null
GetPrimaryKey = Null

GetPrimaryKey_Exit:
End Function

 

[Douglas J Steele]

You're saying that there are actually supposed to be two fields (ID and
User) in the index? Then you need to add two separate fields:

idxFld = "ID"
Set idxFld = idx.CreateField(idxFld)
idx.Fields.Append idxFld
idxFld = "User"
Set idxFld = idx.CreateField(idxFld)
idx.Fields.Append idxFld

Part of the problem is the fact that you've got

On Error Resume Next

in your code.

That means that when Access encounters an error, it ignores it, and carries
on. If you had proper error trapping, you would have got an error when you
tried to add the (presumably non-existent) field named UserID

 

[traveler]

Doug,
Thanks for the reply. Actually, I only want ID to be in the index. Does
the code say otherwise? What do I need to change to make this simply add one
field called "ID" and make it the primary key?

 

[Douglas J Steele]

Must have misread what you wrote.

For only ID to be in the index, use

idxFld = "ID"
Set idxFld = idx.CreateField(idxFld)
idx.Fields.Append idxFld

(You have UserID in your sample code)

 

[traveler]

Doug,
When I take out the On Error Resume Next and replace it with:
On Error GoTo Err_Make_tblUsersPKey

and insert the following at the end of the routine:

Exit_Make_tblUsersPKey
Exit Sub

Err_Make_tblUserPKey
MsgBox Err.Description
Resume Exit_Make_tblUserPKey
End Sub


I get a compile error on the Exit_Make_tblUsersPKey statement. I don't
understand why.

:

 

[traveler]

Also ... I changed the "UserID" to "ID" but I still get no change in the table.

 

[Douglas J. Steele]

You need colons at the ends of the labels:


Exit_Make_tblUsersPKey:
Exit Sub

Err_Make_tblUserPKey:
MsgBox Err.Description
Resume Exit_Make_tblUserPKey
End Sub

 

[Douglas J Steele]

Revisiting your code, there 's an error in it that I failed to catch
earlier.

idxFld = "ID"
Set idxFld = idx.CreateField(idxFld)
idx.Fields.Append idxFld

is definitely wrong. You can't assign idxFld a string that contains the name
of the field, and then attempt to make it a field as well.

Your declaration should be

Dim dbs As Database
Dim tdf As DAO.TableDef
Dim idx As DAO.Index
Dim idxFld As DAO.Field
Dim varPKey As Variant

and your code should be

Set idxFld = idx.CreateField("ID")
idx.Fields.Append idxFld

Alternatively, you could declare

Dim dbs As Database
Dim tdf As DAO.TableDef
Dim idx As DAO.Index
Dim idxFld As DAO.Field
Dim varPKey As Variant
Dim strFld As String

and

strFld = "ID"
Set idxFld = idx.CreateField(strFld)
idx.Fields.Append idxFld