Full Version: How do you add a primary key to a table using VBA code?
How do you add a primary key to a table using VBA code? I have imported an Excel spreadsheet and want to put in the primary key automatically after the import.
Hi Duane,
here is some code you can put into a standard (general) module:
here is some code you can put into a standard (general) module:
CODE
'~~~~~~~~~~~~~~~~
'example showing how to add certain fields to a particular table
'~~~~~~~~~~~~~~~~
Sub testaddFieldToTable()
' AddFieldToTable "test", "AutoID", dbLong, , "*AN*"
' AddFieldToTable "test", "SomeID", dbLong, , "*Null*"
' AddFieldToTable "test", "ImportLog", dbText, 255
AddFieldToTable "test", "DateCreated", dbDate, , "*Now*"
End Sub
'~~~~~~~~~~~~~~~~
'example showing how to add the same fields
'to every user table in the database
'~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~ RunAddFieldsToTable_Tracking
Sub RunAddFieldsToTable_Tracking()
Dim tdf As DAO.TableDef
Dim mCountDone As Integer _
, mCountChecked As Integer
For Each tdf In CurrentDb.TableDefs
If Left(tdf.Name, 4) <> "Msys" Then
Debug.Print
Debug.Print tdf.Name & "...";
mCountChecked = mCountChecked + 1
If AddFieldToTable(tdf.Name, "EmpIDadd", dbLong _
, , "*Null*", "employee who added record") Then
mCountDone = mCountDone + 1
Debug.Print " EmpIDadd";
End If
If AddFieldToTable(tdf.Name, "EmpIDedit" _
, dbLong, , "*Null*", "employee who last edited record") Then
mCountDone = mCountDone + 1
Debug.Print " EmpIDedit";
End If
If AddFieldToTable(tdf.Name, "datAdd", dbDate _
, , "*Now*", "date record was added") Then
mCountDone = mCountDone + 1
Debug.Print " datAdd";
End If
If AddFieldToTable(tdf.Name, "datEdit", dbDate _
, , , "date record was last edited") Then
mCountDone = mCountDone + 1
Debug.Print " datEdit";
End If
End If
Next tdf
MsgBox mCountChecked & " tables checked" & vbCrLf & vbCrLf _
& "Added " _
& mCountDone & " tracking fields" _
, , "Add Tracking Fields to Table Design"
Proc_Exit:
On Error Resume Next
'close and release object variables
Set tdf = Nothing
Exit Sub
Proc_Err:
Select Case Err.Number
' 'Caption property not found
Case 3270: Resume Next
End Select
MsgBox Err.Description, , _
"ERROR " & Err.Number _
& " addTrackingFieldsToTable"
'press F8 to step through code and debug
'remove next line after debugged
Stop: Resume
Resume Proc_Exit
End Sub
'~~~~~~~~~~~~~~~~
'put the following function in a general module:
'~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~ AddFieldToTable
Function AddFieldToTable( _
pTablename As String, _
pFldname As String, _
pDataType As Integer, _
Optional pFieldSize As Integer, _
Optional pDefaultValue As String = "", _
Optional pDesc As String = "", _
Optional pSkipMessage As Boolean = True) _
As Boolean
'written by Crystal
'strive4peace2007 at yahoo.com
'modified 8-28-07
'PARAMETERS
'pTablename --> name of table to modify structure of
'pFldname --> name of field to create
'pDataType --> dbText, dbLong, dbDate, etc
'pFieldSize --> length for text fields
'pDefaultValue --> *AN* = autonumber
' --> *Null* --> DefaultValue = Null
' --> *Now* --> DefaultValue = Now()
' --> otherwise whatever is specified
'NEEDS Reference to
'a Microsoft DAO Library
On Error GoTo Proc_Err
AddFieldToTable = False
Dim db As DAO.Database, fld As DAO.Field
'you could make this a passed parameter
' and open another database
Set db = CurrentDb
With db.TableDefs(pTablename)
Select Case pDataType
Case dbText
'Text
Set fld = .CreateField(pFldname, _
pDataType, pFieldSize)
Case Else
'Long Integer, Date, etc
Set fld = .CreateField(pFldname, pDataType)
End Select
If Len(pDefaultValue) > 0 Then
Select Case pDefaultValue
Case "*AN*"
'Autonumber
fld.Attributes = dbAutoIncrField
Case "*Null*"
'Null for DefaultValue
fld.DefaultValue = "Null"
Case "*Now*"
'Now for DefaultValue
fld.DefaultValue = "=Now()"
Case Else
'Now for DefaultValue
fld.DefaultValue = "=" & pDefaultValue
End Select
End If
If pDataType = dbText Then
fld.AllowZeroLength = True
End If
.Fields.Append fld
If Len(pDesc) > 0 Then
On Error Resume Next
fld.Properties("Description") = pDesc
If Err > 0 Then
fld.Properties.Append fld.CreateProperty("Description" _
, dbText, pDesc)
End If
On Error GoTo Proc_Err
End If
End With
db.TableDefs.Refresh
DoEvents
If Not pSkipMessage Then
MsgBox "Added --> " & pFldname _
& " to --> " & pTablename, , "Done"
End If
AddFieldToTable = True
Proc_Exit:
On Error Resume Next
If Not fld Is Nothing Then Set fld = Nothing
'if db is external and you OPENed it,
'you will need to close it too
If Not db Is Nothing Then Set db = Nothing
Exit Function
Proc_Err:
'if the field is already there, ignore error
If Err = 3191 Then Resume Proc_Exit
'linked table
If Err = 3057 Then Resume Proc_Exit
MsgBox Err.Description, , _
"ERROR " & Err.Number & " AddFieldToTable"
'press F8 to step through code and debug
'remove or comment next line after debugged
If IsAdmin Then Stop: Resume 'next line will be the one with the error
Resume Proc_Exit
End Function
'example showing how to add certain fields to a particular table
'~~~~~~~~~~~~~~~~
Sub testaddFieldToTable()
' AddFieldToTable "test", "AutoID", dbLong, , "*AN*"
' AddFieldToTable "test", "SomeID", dbLong, , "*Null*"
' AddFieldToTable "test", "ImportLog", dbText, 255
AddFieldToTable "test", "DateCreated", dbDate, , "*Now*"
End Sub
'~~~~~~~~~~~~~~~~
'example showing how to add the same fields
'to every user table in the database
'~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~ RunAddFieldsToTable_Tracking
Sub RunAddFieldsToTable_Tracking()
Dim tdf As DAO.TableDef
Dim mCountDone As Integer _
, mCountChecked As Integer
For Each tdf In CurrentDb.TableDefs
If Left(tdf.Name, 4) <> "Msys" Then
Debug.Print
Debug.Print tdf.Name & "...";
mCountChecked = mCountChecked + 1
If AddFieldToTable(tdf.Name, "EmpIDadd", dbLong _
, , "*Null*", "employee who added record") Then
mCountDone = mCountDone + 1
Debug.Print " EmpIDadd";
End If
If AddFieldToTable(tdf.Name, "EmpIDedit" _
, dbLong, , "*Null*", "employee who last edited record") Then
mCountDone = mCountDone + 1
Debug.Print " EmpIDedit";
End If
If AddFieldToTable(tdf.Name, "datAdd", dbDate _
, , "*Now*", "date record was added") Then
mCountDone = mCountDone + 1
Debug.Print " datAdd";
End If
If AddFieldToTable(tdf.Name, "datEdit", dbDate _
, , , "date record was last edited") Then
mCountDone = mCountDone + 1
Debug.Print " datEdit";
End If
End If
Next tdf
MsgBox mCountChecked & " tables checked" & vbCrLf & vbCrLf _
& "Added " _
& mCountDone & " tracking fields" _
, , "Add Tracking Fields to Table Design"
Proc_Exit:
On Error Resume Next
'close and release object variables
Set tdf = Nothing
Exit Sub
Proc_Err:
Select Case Err.Number
' 'Caption property not found
Case 3270: Resume Next
End Select
MsgBox Err.Description, , _
"ERROR " & Err.Number _
& " addTrackingFieldsToTable"
'press F8 to step through code and debug
'remove next line after debugged
Stop: Resume
Resume Proc_Exit
End Sub
'~~~~~~~~~~~~~~~~
'put the following function in a general module:
'~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~ AddFieldToTable
Function AddFieldToTable( _
pTablename As String, _
pFldname As String, _
pDataType As Integer, _
Optional pFieldSize As Integer, _
Optional pDefaultValue As String = "", _
Optional pDesc As String = "", _
Optional pSkipMessage As Boolean = True) _
As Boolean
'written by Crystal
'strive4peace2007 at yahoo.com
'modified 8-28-07
'PARAMETERS
'pTablename --> name of table to modify structure of
'pFldname --> name of field to create
'pDataType --> dbText, dbLong, dbDate, etc
'pFieldSize --> length for text fields
'pDefaultValue --> *AN* = autonumber
' --> *Null* --> DefaultValue = Null
' --> *Now* --> DefaultValue = Now()
' --> otherwise whatever is specified
'NEEDS Reference to
'a Microsoft DAO Library
On Error GoTo Proc_Err
AddFieldToTable = False
Dim db As DAO.Database, fld As DAO.Field
'you could make this a passed parameter
' and open another database
Set db = CurrentDb
With db.TableDefs(pTablename)
Select Case pDataType
Case dbText
'Text
Set fld = .CreateField(pFldname, _
pDataType, pFieldSize)
Case Else
'Long Integer, Date, etc
Set fld = .CreateField(pFldname, pDataType)
End Select
If Len(pDefaultValue) > 0 Then
Select Case pDefaultValue
Case "*AN*"
'Autonumber
fld.Attributes = dbAutoIncrField
Case "*Null*"
'Null for DefaultValue
fld.DefaultValue = "Null"
Case "*Now*"
'Now for DefaultValue
fld.DefaultValue = "=Now()"
Case Else
'Now for DefaultValue
fld.DefaultValue = "=" & pDefaultValue
End Select
End If
If pDataType = dbText Then
fld.AllowZeroLength = True
End If
.Fields.Append fld
If Len(pDesc) > 0 Then
On Error Resume Next
fld.Properties("Description") = pDesc
If Err > 0 Then
fld.Properties.Append fld.CreateProperty("Description" _
, dbText, pDesc)
End If
On Error GoTo Proc_Err
End If
End With
db.TableDefs.Refresh
DoEvents
If Not pSkipMessage Then
MsgBox "Added --> " & pFldname _
& " to --> " & pTablename, , "Done"
End If
AddFieldToTable = True
Proc_Exit:
On Error Resume Next
If Not fld Is Nothing Then Set fld = Nothing
'if db is external and you OPENed it,
'you will need to close it too
If Not db Is Nothing Then Set db = Nothing
Exit Function
Proc_Err:
'if the field is already there, ignore error
If Err = 3191 Then Resume Proc_Exit
'linked table
If Err = 3057 Then Resume Proc_Exit
MsgBox Err.Description, , _
"ERROR " & Err.Number & " AddFieldToTable"
'press F8 to step through code and debug
'remove or comment next line after debugged
If IsAdmin Then Stop: Resume 'next line will be the one with the error
Resume Proc_Exit
End Function
Crystal,
I don't understand this module. You have things about employees, etc. And I am wondering how to call it. And as for primary keys, I don't see it addressed in it. I do have the following module which I found in a book. The module runs; however, it does not add a primary key or change the table in any way. Maybe you could either clarify your own or help me with this one:
I tried calling it with this statement:
CreatePKIndexes "Wave1Import","SRC_CUST_ID"
"Wave1Import" is the table name, "SRC_CUST_ID" is the field I want to create the primary key on. The table was created with the following import from Excel statement:
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Wave1Import", "ExcelDataFile.xls", True
Thank you for any help.
I don't understand this module. You have things about employees, etc. And I am wondering how to call it. And as for primary keys, I don't see it addressed in it. I do have the following module which I found in a book. The module runs; however, it does not add a primary key or change the table in any way. Maybe you could either clarify your own or help me with this one:
CODE
Option Compare Database
Public Sub CreatePKIndexes(strTableName As String, ParamArray varPKFields() As Variant)
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(strTableName)
'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
'Append the fields
For Each idxFld In varPKFields
Set idxFld = idx.CreateField(idxFld)
idx.Fields.Append idxFld
Next 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
'Determine 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
Public Sub CreatePKIndexes(strTableName As String, ParamArray varPKFields() As Variant)
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(strTableName)
'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
'Append the fields
For Each idxFld In varPKFields
Set idxFld = idx.CreateField(idxFld)
idx.Fields.Append idxFld
Next 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
'Determine 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
I tried calling it with this statement:
CreatePKIndexes "Wave1Import","SRC_CUST_ID"
"Wave1Import" is the table name, "SRC_CUST_ID" is the field I want to create the primary key on. The table was created with the following import from Excel statement:
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Wave1Import", "ExcelDataFile.xls", True
Thank you for any help.
Hi Duane,
why are you not using the code I gave you? It works. Just create a general module and put it in there. You will need a reference to a Microsoft DAO Library. Then compile it
'~~~~~~~~~ How to Create a General Module ~~~~~~~~~
1. from the database window, click on the Module tab
2. click on the NEW command button
3. type (or paste) the code in
once the code is in the module sheet, do
Debug,Compile from the menu
if there are no syntax/reference errors, nothing will appear to happen -- this is good
Make sure to give the module a good name when you save it. You can have several procedures in a module, so I like to group them.
'~~~~~~~~~ DAO Library Reference ~~~~~~~~~
make sure you have a reference to a Microsoft DAO Library
Tools, References... from a module window
scroll to Microsoft DAO 3.6 Object Library and check it
'~~~~~~~~~ Compile ~~~~~~~~~
Whenever you change code or references, your should always compile before executing.
from the menu in a module window: Debug, Compile
fix any errors on the yellow highlighted lines
keep compiling until nothing happens (this is good!)
****************
here would be your code to add the field you want:
why are you not using the code I gave you? It works. Just create a general module and put it in there. You will need a reference to a Microsoft DAO Library. Then compile it
'~~~~~~~~~ How to Create a General Module ~~~~~~~~~
1. from the database window, click on the Module tab
2. click on the NEW command button
3. type (or paste) the code in
once the code is in the module sheet, do
Debug,Compile from the menu
if there are no syntax/reference errors, nothing will appear to happen -- this is good
Make sure to give the module a good name when you save it. You can have several procedures in a module, so I like to group them.
'~~~~~~~~~ DAO Library Reference ~~~~~~~~~
make sure you have a reference to a Microsoft DAO Library
Tools, References... from a module window
scroll to Microsoft DAO 3.6 Object Library and check it
'~~~~~~~~~ Compile ~~~~~~~~~
Whenever you change code or references, your should always compile before executing.
from the menu in a module window: Debug, Compile
fix any errors on the yellow highlighted lines
keep compiling until nothing happens (this is good!)
****************
here would be your code to add the field you want:
CODE
AddFieldToTable "Wave1Import", "SRC_CUST_ID", dbLong, , "*AN*"
WOW!! ... Crystal! ... that is some code you got there! ... very good indeed, quite versatile!
....
Despite the fine example of code, I offer the OP this simple function to perform the exact task
Where tblYourTablename is the name of your table, YourColumnName is the name of your NEW column, and PKName is the name of the Index you wish to create and tag as the PRIMARY KEY.
....
Despite the fine example of code, I offer the OP this simple function to perform the exact task
CODE
Public Sub AddAutoNumPK()
Dim strSQL As String
strSQL = "ALTER TABLE tblYourTablename" & _
" ADD COLUMN YourColumnName" & _
" COUNTER CONSTRAINT PKName PRIMARY KEY"
CurrentDb.Execute strSQL, dbFailOnError
End Sub
Dim strSQL As String
strSQL = "ALTER TABLE tblYourTablename" & _
" ADD COLUMN YourColumnName" & _
" COUNTER CONSTRAINT PKName PRIMARY KEY"
CurrentDb.Execute strSQL, dbFailOnError
End Sub
Where tblYourTablename is the name of your table, YourColumnName is the name of your NEW column, and PKName is the name of the Index you wish to create and tag as the PRIMARY KEY.
I apologize for not making this clear - by the way, your module does the same thing as mine - nothing - but, I didn't make clear that SRC_CUST_ID is already a populated field in the table. I just want to make it the PK. Can you help me with that? And, I will be thankful for the other code, as I can already think os some uses for it. The values are already unique. I just want to make it the Primary Key sorted Ascending.
AHHHH .... I see ....
Then we need to create and INDEX and tag it as the PRIMARY KEY index ... So ... change the strSQL variable in the above code to:
Execution of the above SQL statment will create an Index named "PrimaryKey" on the "SRC_CUST_ID" field of the table "Wave1Import" and tag that index as the PRIMARY KEY index for the table.
....
Please note that there are other ways to add an index and tag that index as the primary key. Like through the DAO object library and its methods.... Are you interested, or does the SQL statement satisfy your request.
Then we need to create and INDEX and tag it as the PRIMARY KEY index ... So ... change the strSQL variable in the above code to:
CODE
strSQL = "ALTER TABLE Wave1Import" & _
" ADD CONSTRAINT PrimaryKey" & _
" PRIMARY KEY (SRC_CUST_ID)"
" ADD CONSTRAINT PrimaryKey" & _
" PRIMARY KEY (SRC_CUST_ID)"
Execution of the above SQL statment will create an Index named "PrimaryKey" on the "SRC_CUST_ID" field of the table "Wave1Import" and tag that index as the PRIMARY KEY index for the table.
....
Please note that there are other ways to add an index and tag that index as the primary key. Like through the DAO object library and its methods.... Are you interested, or does the SQL statement satisfy your request.
and, here is some things that are wrong with your code:
after
tdf.Indexes.Delete varPKey
you probably need:
dbs.tabldefs.refresh
I think you can delete:
idx.Required = True
idx.Unique = True
since
idx.Primary = True
includes these as well
you can't do this:
Set idxFld = idx.CreateField(idxFld)
instead, do this
after
tdf.Indexes.Delete varPKey
you probably need:
dbs.tabldefs.refresh
I think you can delete:
idx.Required = True
idx.Unique = True
since
idx.Primary = True
includes these as well
you can't do this:
Set idxFld = idx.CreateField(idxFld)
instead, do this
CODE
For Each idxFld In varPKFields
idx.Fields.Append idx.CreateField(idxFld)
Next idxFld
idx.Fields.Append idx.CreateField(idxFld)
Next idxFld
I am interested in any other ways, too, as I know that each one has its limitations. This one may work this time, but I may need a variant the next time.
Thank you, Crystal for these other insights as well. I was wondering about the tabledefs.refresh. Interestingly, this code was type exactly out of the "Access 2003 VBA Programmer's Reference." You would think that they had it straight.
Duane ...
Here are the generic procedures I use to create an index on a table. I pretty much use DAO (or SQL statements) for my Data Definition needs, but an ADOX method is below as well {it after the DAO procedure}.
Both procedures are called the same way and will yeild a primary key index with the following call (Note: this ASSUMES the proper libraries have been referenced:
DAO_CreateIndex "Wave1Import", "PrimaryKey", "SRC_CUST_ID",True
HTH ...
Here are the generic procedures I use to create an index on a table. I pretty much use DAO (or SQL statements) for my Data Definition needs, but an ADOX method is below as well {it after the DAO procedure}.
Both procedures are called the same way and will yeild a primary key index with the following call (Note: this ASSUMES the proper libraries have been referenced:
DAO_CreateIndex "Wave1Import", "PrimaryKey", "SRC_CUST_ID",True
CODE
Public Sub DAO_CreateIndex(strTableName As String, _
strIndexName As String, _
strWithField As String, _
Optional blIsPrimary As Boolean, _
Optional blDescending As Boolean, _
Optional blIsUnique As Boolean)
'Create an index for the passed table, using the passed name and settings
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim idx As DAO.Index
Dim fld As DAO.Field
Set db = CurrentDb
Set tdf = db.TableDefs(strTableName)
With tdf
'Instantiate the index
Set idx = .CreateIndex(strIndexName)
'Set the fields and properties of the index
Set fld = idx.CreateField(strWithField)
If blDescending Then fld.Attributes = dbDescending
idx.Fields.Append fld
idx.Primary = blIsPrimary
If Not blIsPrimary Then idx.Unique = blIsUnique
'Append the index to collection
.Indexes.Append idx
End With
End Sub
Public Sub ADOX_CreateIndex(strTableName As String, _
strIndexName As String, _
strWithField As String, _
Optional blIsPrimary As Boolean, _
Optional blDescending As Boolean, _
Optional blIsUnique As Boolean)
'Create an index for the passed table, using the passed name and settings
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim idx As ADOX.Index
Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection.ConnectionString
Set tbl = cat.Tables(strTableName)
With tbl
'Instantiate the index
Set idx = New ADOX.Index
'Set the Columns and properties of the index
idx.Name = strIndexName
idx.Columns.Append strWithField
If blDescending Then
idx.Columns(strWithField).SortOrder = adSortDescending
End If
idx.PrimaryKey = blIsPrimary
If Not blIsPrimary Then idx.Unique = blIsUnique
'Append the index to collection
.Indexes.Append idx
End With
End Sub
strIndexName As String, _
strWithField As String, _
Optional blIsPrimary As Boolean, _
Optional blDescending As Boolean, _
Optional blIsUnique As Boolean)
'Create an index for the passed table, using the passed name and settings
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim idx As DAO.Index
Dim fld As DAO.Field
Set db = CurrentDb
Set tdf = db.TableDefs(strTableName)
With tdf
'Instantiate the index
Set idx = .CreateIndex(strIndexName)
'Set the fields and properties of the index
Set fld = idx.CreateField(strWithField)
If blDescending Then fld.Attributes = dbDescending
idx.Fields.Append fld
idx.Primary = blIsPrimary
If Not blIsPrimary Then idx.Unique = blIsUnique
'Append the index to collection
.Indexes.Append idx
End With
End Sub
Public Sub ADOX_CreateIndex(strTableName As String, _
strIndexName As String, _
strWithField As String, _
Optional blIsPrimary As Boolean, _
Optional blDescending As Boolean, _
Optional blIsUnique As Boolean)
'Create an index for the passed table, using the passed name and settings
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim idx As ADOX.Index
Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection.ConnectionString
Set tbl = cat.Tables(strTableName)
With tbl
'Instantiate the index
Set idx = New ADOX.Index
'Set the Columns and properties of the index
idx.Name = strIndexName
idx.Columns.Append strWithField
If blDescending Then
idx.Columns(strWithField).SortOrder = adSortDescending
End If
idx.PrimaryKey = blIsPrimary
If Not blIsPrimary Then idx.Unique = blIsUnique
'Append the index to collection
.Indexes.Append idx
End With
End Sub
HTH ...
Thanks for these last hints as well. I will put them in my little "bag of tricks"
Spot on. Nice one!
This is a "lo-fi" version of our main content. To view the full version with more information, formatting and images, please click here.