Drop Index with VBA

[llkhoutx]

I'm using VBA to programmitically delete unwanted fields in about 100 tables to avoid doing it manually and missing some.

Indexed fields must first have the index dropped.

How do I indentify indexed fields programmatically in VBA?

Example:

table: tbP01
Fields: ID1,ID2,ID3,X1,X2,X3,X4

I know that I want to delete X2 AND X3. They may or may not be indexed. How do I tell programmitically in VBA if they're indexed so as to trigger a DROP INDEX instruction?

Thank you in advance.

 

[raskew]

I'll try this again. The first response went off into cyber-space.

The following code will create tblIndex and populate it from with index info from all the tables in your application. From their you should be able to use VBA to link to field-elimination process.

Sub GetIndex3Description()

Dim db As Database, td As TableDef
Dim rs As Recordset, rs2 As Recordset
Dim fld As Field, found As Boolean

Dim test As String, namehold As String
Dim FieldDescription As String, tName As String
Dim strSQL As String, idxLoop As Index

Dim TypeHold As Integer, SizeHold As Integer
Dim FieldAttributes As Integer, prpLoop As Property

Dim n As Long, i As Long
Dim recis As Variant

n = 0
Set db = CurrentDb
' Trap for any errors.
On Error Resume Next

tName = "tblIndex"
'Does table "tblIndex" exist?  If true, delete it;
found = False
test = db.TableDefs(tName).Name
If Err <> 3265 Then
   found = True
   DoCmd.SetWarnings False
   DoCmd.DeleteObject acTable, "tblIndex"
   DoCmd.SetWarnings True
End If
Resume Next
'Create new tblTable
db.Execute "CREATE TABLE tblIndex(Object TEXT (55), IndexName TEXT (55));"
'added new fields in this manner because I couldn't get
'boolean fields to work with CREATE TABLE
Set td = db.TableDefs("tblIndex")
AppendDeleteField td, "APPEND", "FieldName", dbText, 55
AppendDeleteField td, "APPEND", "PrimaryKey", dbBoolean
AppendDeleteField td, "APPEND", "IsUnique", dbBoolean
AppendDeleteField td, "APPEND", "IsIgnoreNulls", dbBoolean

strSQL = "SELECT Name, Type From MSysObjects" _
      & " WHERE (((MSysObjects.Type) = 1))" _
      & " ORDER BY MSysObjects.Name;"
      
Set rs = db.OpenRecordset(strSQL)

If Not rs.BOF Then
   ' Get number of records in recordset
   rs.MoveLast
   n = rs.RecordCount
   rs.MoveFirst
End If

Set rs2 = db.OpenRecordset("tblIndex")

For i = 0 To n - 1
   FieldDescription = " "
   Set td = db.TableDefs(i)
   If left(rs!Name, 4) <> "MSys" Then
       namehold = rs!Name
       found = False
       On Error Resume Next
       For Each idxLoop In td.Indexes
            rs2.AddNew
            rs2!Object = namehold
            rs2!indexname = idxLoop.Name
            rs2!FieldName = idxLoop.Fields
            rs2!primarykey = idxLoop.Primary
            rs2!IsUnique = idxLoop.Unique
            rs2!IsIgnoreNulls = idxLoop.IgnoreNulls
            rs2!Field = idxLoop.Fields
            rs2.Update
       Next idxLoop
  
       Resume Next
    End If
    rs.MoveNext
Next i
rs.Close
' Get rid of any replication fields
strSQL = "DELETE tblIndex.*, tblIndex.IndexName FROM tblIndex" _
      & " WHERE (((tblIndex.IndexName)='s_generation')) OR" _
      & " (((tblIndex.IndexName)='s_lineage')) OR (((tblIndex.IndexName)='s_GUID'));"

DoCmd.SetWarnings False
DoCmd.RunSQL (strSQL)
DoCmd.SetWarnings True

End Sub


Sub AppendDeleteField(tdfTemp As TableDef, _
    strCommand As String, strName As String, _
    Optional varType, Optional varSize)

    With tdfTemp

        ' Check first to see if the TableDef object is
        ' updatable. If it isn't, control is passed back to

' the calling procedure.
        If .Updatable = False Then
            MsgBox "TableDef not Updatable! " & _
                "Unable to complete task."
            Exit Sub
        End If

        ' Depending on the passed data, append or delete a
        ' field to the Fields collection of the specified
        ' TableDef object.
        If strCommand = "APPEND" Then
            .Fields.Append .CreateField(strName, _
                varType, varSize)
        Else
            If strCommand = "DELETE" Then .Fields.Delete strName
        End If

    End With

End Sub

HTH-Bob

 

[WayneRyan]

Bob,

Nice piece of code!

I'll find a use for that.

Thanks,
Wayne

 

[llkhoutx]

Killer code. I'll give it a try. Many thanks.