change Indexed field to "No"

[TrevoriousD]

Hi. Can somebody please help me out here. I have 3 things that i want to do via VBA but cant find what im looking for in the net.

1. I want to be able to change any indexed fields in a table to not indexed. for example. the fields are set as Indexed = Yes (No Duplicates) and i want them to be set as Indexed = No.

2. I want to change all fields in a table that are AutoNumber to Number(long)

3. I want to remove all primary keys from a table.

If anyone can help me with this i would be supa greatful.

thanks

trevor

[Jim Doherty]

@TrevoriousD
I Have knocked together a module for you to look at and attached it as a textfile as well.

Import it into a spare copy of Microsofts example database 'Northwind' and test it out by typing the function name BanishIndexes at the immediate window or assign the function to a button or whatever else is your flavour in a copy of your own database, whatever that is, to satisfy yourself that it performs as expected.

The VBA routines therein should be sufficient to fit your needs or give you some ideas as to which code segments might be relevant to you.

Basically what the module does is firstly count any relationships defined in your database. If there are relationships it will ask you if you wish to drop them (given you are rather limited as to what you can accomplish if relationships between primary keys exist) A new table is created named tblIndexes and populated with all table names and indexes except Access system tables (tables names prefixed with 'MSys').

tblIndexes is traversed in a code loop dropping indexes for all table names contained in tblIndexes accordingly. This table (tblIndexes) is ultimately left in your database as a reference point for you to examine post processing. Delete at your leisure.

The autonumber columns are dealt with by firstly asking you if you wish to deal with that element at the same time. If so it continues examining autonumber fields and 'dropping' them, but not without first placing any data contents into a 'holding' field and then recreating the original autonumber field as a long integer field and repopulating it.

The downside of this field creation 'as is' of course is that it places the newly created and populated long integer field (hitherto autonumber) at the 'end' of the field stack (you will see it as the last field listed in table design view) but with development you could rearrange this if needs be

Regards :)

'---------------------------------------------------------------------------------------
' Module    : bas_BanishIndexes
' Author    : Jim Doherty www.Bytes.com
' Date      : 05/07/2010
' Reference : http://bytes.com/topic/access/answers/890981-change-indexed-field-no
' Purpose   : To deal with three issues as requested on the forum
'1. to be able to change any indexed fields in a table to not indexed. for example.
'the fields are set as Indexed = Yes (No Duplicates) and i want them to be set as Indexed = No.
'2. I want to change all fields in a table that are AutoNumber to Number(long)
'3. I want to remove all primary keys from a table.
 
'Tested on Northwind database tables  and works ok! but test it out yourself on a spare copy  USE AT YOUR RISK!
'---------------------------------------------------------------------------------------
Option Explicit
 
Sub CreateTable_tblIndexes()
    On Error GoTo CreateTable_tblIndexes_Error
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim ind As DAO.Index
 
    Set db = CurrentDb()
    For Each tdf In db.TableDefs    'delete any pre-existing tblindex table
        If tdf.Name = "tblIndexes" Then db.TableDefs.Delete "tblIndexes"
    Next
    Set tdf = db.CreateTableDef("tblIndexes")
    With tdf
        Set fld = .CreateField("Row", dbLong)
        fld.Attributes = dbAutoIncrField + dbFixedField
        .Fields.Append fld
        .Fields.Append .CreateField("TableName", dbText, 100)
        .Fields.Append .CreateField("FieldCount", dbLong)
        .Fields.Append .CreateField("IndexName", dbText, 100)
        .Fields.Append .CreateField("Sequence", dbLong)
        .Fields.Append .CreateField("Primary", dbBoolean)
        .Fields.Append .CreateField("Unique", dbBoolean)
    End With
    db.TableDefs.Append tdf
    Set ind = tdf.CreateIndex("PrimaryKey")
    With ind
        .Fields.Append .CreateField("Row")
        .Unique = True
        .Primary = True
    End With
    tdf.Indexes.Append ind
    RefreshDatabaseWindow
    Set fld = Nothing
    Set tdf = Nothing
    Set db = Nothing
 
    On Error GoTo 0
    Exit Sub
CreateTable_tblIndexes_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & _
           ") in procedure CreateTable_tblIndexes of Module bas_BanishIndexes"
End Sub
 
Function DoIndexes(tbl, rstIndexes As Object)
    On Error GoTo DoIndexes_Error
    Dim idx As DAO.Index
    Dim Ctr As Integer  'counter (simply for sequencing)
    Ctr = 1
    BeginTrans
    For Ctr = 1 To tbl.Indexes.Count
        Set idx = tbl.Indexes(Ctr - 1)
        rstIndexes.AddNew
        rstIndexes!TableName = tbl.Name
        rstIndexes!FieldCount = tbl.Fields.Count
        rstIndexes!IndexName = idx.Name
        rstIndexes!Sequence = Ctr
        rstIndexes!Primary = idx.Primary
        rstIndexes!Unique = idx.Unique
        rstIndexes.Update
        '  wIdxCtr = wIdxCtr + 1
    Next Ctr
    CommitTrans
    Set idx = Nothing
 
    On Error GoTo 0
    Exit Function
 
DoIndexes_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & _
        ") in procedure DoIndexes of Module bas_BanishIndexes"
End Function
 
Function ExamineIndexes()
    On Error GoTo ExamineIndexes_Error
    Dim Mydb As DAO.Database
    Dim MyRS As DAO.Recordset
    Dim tbl As DAO.TableDef
    Dim rstIndexes As DAO.Recordset
    Dim MyFields As DAO.Recordset
    Dim MyField As DAO.Field
    Dim MyIndex As DAO.Index
    Dim MyIndexfields
    Dim strSQL As String
    Dim mystr As String, myndxstr As String
    Dim MyIndexunique
    Dim j As Long, cnt As Long
    Dim x
 
    Set Mydb = CurrentDb
    Set rstIndexes = Mydb.OpenRecordset("SELECT * FROM tblIndexes WHERE 1=2", dbOpenDynaset)
    BeginTrans
    SysCmd acSysCmdInitMeter, "Examining tables: ", CurrentDb.TableDefs.Count
    cnt = 1
    For Each tbl In CurrentDb.TableDefs
        SysCmd acSysCmdUpdateMeter, cnt
        If Left(tbl.Name, 4) <> "MSys" Then
            If tbl.Name <> "tblIndexes" Then
                x = DoIndexes(tbl, rstIndexes)
            End If
 
        End If
        cnt = cnt + 1
    Next tbl
    CommitTrans
    SysCmd acSysCmdRemoveMeter
    rstIndexes.Close
    Set rstIndexes = Nothing
    Set MyIndex = Nothing
    Set tbl = Nothing
    Set Mydb = Nothing
    strSQL = ""
 
    On Error GoTo 0
    Exit Function
ExamineIndexes_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & _
        ") in procedure ExamineIndexes of Module bas_BanishIndexes"
End Function
 
'---------------------------------------------------------------------------------------
' Procedure : BanishIndexes
' Author    : Jim Doherty
' Date      : 05/07/2010
' Purpose   : Run this from the immediate window simply type the Function name
            '    ?BanishIndexes
            'and hit enter   (You can if you wish assign the function to a button on a form up to you)
'           The procedure will call a routine to create a table inwhich is pumped table indexes
            'the table is ultimately traversed and relevant indexes dropped as outlined by the
            'contents of the table created called tblIndexes. The finale is a call to the function
            ''ed AUTOSTOLONG which looks for existing autonumber fields in all tables
            'if it finds one it creates a holding field and updates the contents from the autonumber
            'field. the original autonumber field is then dropped and recreated (cannot rename) and the
            'holding field then puts all the data back into the created  long integer field
'---------------------------------------------------------------------------------------
'
Function BanishIndexes()
    On Error GoTo BanishIndexes_Error
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim msg As String
    Set db = CurrentDb
    If CurrentDb.Relations.Count > 0 Then
        msg = "You have relationships defined in this database" & vbNewLine
        msg = msg & "You cannot drop primary keys unless you delete relationships" & vbNewLine & vbNewLine
        msg = msg & "Do you wish to delete them in order to use this procedure?"
        DoCmd.Beep
        If MsgBox(msg, vbQuestion + vbYesNo, "Drop Relationships") = vbYes Then
            DeleteRelationShips
        Else
            Exit Function
        End If
    End If
    CreateTable_tblIndexes    '<< create a table to store indexes so we have an 'after job done' reference
    ExamineIndexes  '<<< pump all table indexes into the created table
    'Now loop this tblIndexes table using it as a reference and delete the primary keys
    Set rs = db.OpenRecordset("tblIndexes", dbOpenSnapshot)
    Do While Not rs.EOF
        DBEngine(0)(0).TableDefs(rs!TableName).Indexes.Delete (rs!IndexName)
        rs.MoveNext
    Loop
    rs.Close
    AutosToLong
    MsgBox "Process Complete", vbInformation, "System Message"
    Set rs = Nothing
    Set db = Nothing
    On Error GoTo 0
    Exit Function
BanishIndexes_Error:
    If Err.Number = 3281 Then Resume Next    '<< 3281 is error for index used in relation
    MsgBox "Error " & Err.Number & " (" & Err.Description & _
           ") in BanishIndexes of Module bas_BanishIndexes", vbExclamation, _
           "System Message"
End Function
 
'---------------------------------------------------------------------------------------
' Procedure : DeleteRelationShips
' Purpose   : Delete all relationships in the current database
'---------------------------------------------------------------------------------------
Function DeleteRelationShips()
    On Error Resume Next
    Dim rel As DAO.Relation
    For Each rel In CurrentDb.Relations
        CurrentDb.Relations.Delete rel.Name
    Next
End Function
 
'---------------------------------------------------------------------------------------
' Procedure : AutosToLong
' Purpose   : to change all autonumbers to long integer for all tables in the database
'---------------------------------------------------------------------------------------
Function AutosToLong()
    On Error GoTo AutosToLong_Error
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim MyField As String, msg As String
    Set db = CurrentDb
    msg = "Do you wish to change all 'Autonumber' fields to Number Long Integer?"
    If MsgBox(msg, vbQuestion + vbYesNo, "Change Autonumbers") = vbNo Then
        Exit Function
        For Each tdf In CurrentDb.TableDefs
            If Left(tdf.Name, 4) <> "MSys" And tdf.Name <> "tblIndexes" Then
                For Each fld In tdf.Fields
                    If CLng(fld.Type) = dbLong Then
                        If (fld.Attributes And dbAutoIncrField) = 0& Then
                            'it is a long integer so leave alone
                        Else
                            'it is an autonumber so convert by creating a field
                            'then updating it and dropping the original and recreating it
                            DoCmd.SetWarnings False
 
                            BeginTrans
                            tdf.Fields.Append tdf.CreateField("HoldingField", dbLong)
                            DoCmd.RunSQL "UPDATE " & tdf.Name & " SET HoldingField=" & fld.Name & ";"
                            MyField = fld.Name
                            tdf.Fields.Delete fld.Name
                            tdf.Fields.Append tdf.CreateField(MyField, dbLong)
                            DoCmd.RunSQL "UPDATE " & tdf.Name & " SET " & MyField & "=HoldingField;"
                            tdf.Fields.Delete "HoldingField"
                            CommitTrans
                            DoCmd.SetWarnings True
                        End If
                    End If
                Next fld
            End If
        Next tdf
    End If
 
    On Error GoTo 0
    Exit Function
AutosToLong_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & _
        ") in procedure AutosToLong of Module bas_BanishIndexes"
End Function