VBA/Excel/Access/Word/Access/Primary Key

Adding a Primary Key to a Table with SQL command

   <source lang="vb">

Sub AddPrimaryKey()

   Dim conn As ADODB.Connection 
   Dim strTable As String 
   Dim strCol As String 
   On Error GoTo ErrorHandler 
   Set conn = CurrentProject.Connection 
   strTable = "myTable" 
   strCol = "Id" 
   conn.Execute "ALTER TABLE " & strTable & " ADD CONSTRAINT pKey PRIMARY KEY(" & strCol & ");" 

ExitHere:

   conn.Close 
   Set conn = Nothing 
   Exit Sub 

ErrorHandler:

   Debug.Print Err.Number & ":" & Err.Description 
   Resume ExitHere 

End Sub

</source>
   
  

Create a primary key

   <source lang="vb">

Sub ADOCreatePrimaryKey()

   Dim cat As New ADOX.Catalog
   Dim tbl As ADOX.Table
   Dim pk As New ADOX.Key
   
   cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=C:\mydb.mdb;"
   
   Set tbl = cat.Tables("Newtable")
   pk.Name = "PrimaryKey"
   pk.Type = adKeyPrimary
   pk.Columns.Append "Column1"
   tbl.Keys.Append pk

End Sub

</source>
   
  

Creating a Primary Key

   <source lang="vb">

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("vbexTable")
  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 "vbexTable" 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

</source>
   
  

Creating a Single-Field Primary Key with SQL command

   <source lang="vb">

Sub SingleField_PKey()

   Dim conn As ADODB.Connection
   Dim strTable As String
   On Error GoTo ErrorHandler
   Set conn = CurrentProject.Connection
   strTable = "myTable"
   conn.Execute "CREATE TABLE " & strTable _
       & "(SId INTEGER, " _
       & "SName CHAR (30), " _
       & "CONSTRAINT idxPrimary PRIMARY KEY " _
       & "(SId));"
   Application.RefreshDatabaseWindow

ExitHere:

       conn.Close
       Set conn = Nothing
       Exit Sub

ErrorHandler:

       MsgBox Err.Number & ":" & Err.Description
       Resume ExitHere

End Sub

</source>