Sub Create_PrimaryKey()
Dim cat As New ADOX.Catalog
Dim myTable As New ADOX.Table
Dim pKey As New ADOX.Key
On Error GoTo ErrorHandler
cat.ActiveConnection = CurrentProject.Connection
Set myTable = cat.Tables("rntsoftTable")
With pKey
.Name = "PrimaryKey"
.Type = adKeyPrimary
End With
pKey.Columns.Append "Id"
myTable.Keys.Append pKey
Set cat = Nothing
Exit Sub
ErrorHandler:
If Err.Number = -2147217856 Then
MsgBox "The 'rntsoftTable' is open.", _
vbCritical, "Please close the table"
ElseIf Err.Number = -2147217767 Then
myTable.Keys.Delete pKey.Name
Resume
Else
MsgBox Err.Number & ": " & Err.Description
End If
End Sub