How to set Primary Key with VBA?

[BarbQb]

Hi All.

I was wondering if there was a way to set the primary key of a table with VBA? I have a make table query that runs, however when it creates the table it does not set a primary key. I would like to do this with VBA instead of manually.

Any help would be great. Thanks.

[TheSmileyCoder]

Ive written some code for you, that will set the primary key of any table. If a primary key index exists, it will be removed. Hope it helps you.

Public Sub setPrimaryKey(strTblName As String, strFieldName As String)
    'This proc sets the primary key of a table.
    'BEWARE it will delete all other index existing in the table
    'Copyright: TheSmileyCoder
    'This code may be freely used and distributed as long as the copyright notice remains
    
On Error GoTo err_Handler

    Dim tdf As TableDef
    Dim bTableFound As Boolean
    
    
    For Each tdf In CurrentDb.TableDefs
      If tdf.Name = strTblName Then
        bTableFound = True
        Exit For
      End If
    Next tdf

    If Not bTableFound Then
        MsgBox "Table not found"
        Exit Sub
    End If
    Dim myField As Field
    Dim bFieldFound As Boolean
    For Each myField In tdf.Fields
        If myField.Name = strFieldName Then
            bFieldFound = True
            Exit For
        End If
    Next myField
    
    If Not bFieldFound Then
        MsgBox "Field not found"
        Exit Sub
    End If
    
    
    
        
        'Delete the current primary indexes if it exists
        
        Dim idxLoop As Index
        For Each idxLoop In tdf.Indexes
            If idxLoop.Primary Then
                'Existing primary index found, delete it
                tdf.Indexes.Delete idxLoop.Name
                Exit For
            End If
        Next
       
        'Add our new index
        Dim idxNew As Index
        Set idxNew = tdf.CreateIndex("myPrimary")
        
        idxNew.Fields.Append idxNew.CreateField(strFieldName)
        idxNew.Primary = True
        tdf.Indexes.Append idxNew
        
exit_Sub:
    Set myField = Nothing
    Set idxNew = Nothing
    Set tdf = Nothing
    Exit Sub
    
err_Handler:
    MsgBox "Error [" & Err.Number & "] occured." & vbNewLine & Err.desscription
    GoTo exit_Sub
End Sub

[BarbQb]

Thank you very much for the code. Will this work for a Composite Primary Key? I forgot to mention that the PK consists of 3 fields.

[TheSmileyCoder]

To be honest it bugs me quite a bit, that you didn't supply this information up front. Bear in mind that I used atleast 30 mins piecing together that solution for you, and yet you couldn't spend more then 2 minutes posing your question properly. Please try to bear this in mind next time you ask a question.

Here is the modified code which allows you to add up to 3 fields to a composite primary index. It can be be expanded to include more if you want to.

Public Sub setPrimaryKey(strTblName As String, strFieldName As String, Optional strFieldName2 As String, Optional strFieldName3 As String)
    'This proc sets the primary key of a table.
    'BEWARE it will delete all other index existing in the table
    'Copyright: TheSmileyCoder
    'This code may be freely used and distributed as long as the copyright notice remains
    
On Error GoTo err_Handler

    Dim tdf As TableDef
    Dim bTableFound As Boolean
    
    
    For Each tdf In CurrentDb.TableDefs
      If tdf.Name = strTblName Then
        bTableFound = True
        Exit For
      End If
    Next tdf

    If Not bTableFound Then
        MsgBox "Table not found"
        Exit Sub
    End If
    Dim myField As Field
    Dim bFieldFound As Boolean
    For Each myField In tdf.Fields
        If myField.Name = strFieldName Then
            bFieldFound = True
            Exit For
        End If
    Next myField
    
    If Not bFieldFound Then
        MsgBox "Field not found"
        Exit Sub
    End If
    
    
    
        
        'Delete the current primary indexes if it exists
        
        Dim idxLoop As Index
        For Each idxLoop In tdf.Indexes
            If idxLoop.Primary Then
                'Existing primary index found, delete it
                tdf.Indexes.Delete idxLoop.Name
                Exit For
            End If
        Next
       
        'Add our new index
        Dim idxNew As Index
        Set idxNew = tdf.CreateIndex("myPrimary")
        
        idxNew.Fields.Append idxNew.CreateField(strFieldName)
        If strFieldName2 & "" <> "" Then
            'Add extra field (composite index)
            idxNew.Fields.Append idxNew.CreateField(strFieldName2)
        End If
        
        If strFieldName3 & "" <> "" Then
            'Add extra field (composite index)
            idxNew.Fields.Append idxNew.CreateField(strFieldName3)
        End If
        
        idxNew.Primary = True
        tdf.Indexes.Append idxNew
        
exit_Sub:
    Set myField = Nothing
    Set idxNew = Nothing
    Set tdf = Nothing
    Exit Sub
    
err_Handler:
    MsgBox "Error [" & Err.Number & "] occured." & vbNewLine & Err.desscription
    GoTo exit_Sub
End Sub

[Nordo]

Smiley, I just mooched the code you wrote to add a key field (the first response to Barb). Super useful. Clean kill. Worked like a champ with zero mod. Thanks a ton. -Nordo