TKSoft-Online

Sub NewCreateIndexADOX(strTableName As String, strNewIndexName As String, strNewFldName As String, _
                   boolNewIgnoreNull As Boolean, boolNewUnique As Boolean, _
                   Optional boolPrimary As Boolean = False)
'*******************************************
'Name:      NewCreateIndex (Sub)
'Purpose:   Erstellt einen neuen Index für die Tabelle in der angegebenen Datenbank mittels ADOX
'Author:    Thomas Keßler
'Date:      Dezember 01, 2002, 10:05:15
'Inputs:    strTabName = Name der Tabelle, NewIndexName = Name des neuen Indexes
'           NewFldName = Name des neuen Feldes, NewIgnoreNull = Nullwerte ignorieren ?,
'           NewUnique=Index Eindeutig ?
'           boolPrimary=Primär Index
'Output:
'*******************************************
On Error GoTo ErrHandler

Dim cn As New ADODB.Connection
Dim cat As New ADOX.Catalog
Dim tbl As ADOX.Table
Dim idx As ADOX.Index

Set cn = CurrentProject.Connection
Set cat.ActiveConnection = cn
Set tbl = cat.Tables(strTableName)
Set idx = CreateObject("ADOX.Index")
    
    With idx
        .Name = strNewIndexName
        If boolNewIgnoreNull = False Then
            .IndexNulls = adIndexNullsDisallow
        Else
            .IndexNulls = adIndexNullsIgnore
        End If
        .PrimaryKey = boolPrimary
        If boolPrimary = True Then
            .Unique = True
        Else
            .Unique = boolNewUnique
        End If
        .Columns.Append strNewFldName
    End With
    
    tbl.Indexes.Append idx
             
Set cat = Nothing
cn.Close
    
ExitHere:
    Exit Sub
ErrHandler:
    Dim strErrString As String
    strErrString = "Error Information..." & vbCrLf
    strErrString = strErrString & "Error#: " & Err.Number & vbCrLf
    strErrString = strErrString & " Description: " & Err.Description & vbCrLf
    MsgBox strErrString, vbCritical + vbOKOnly, "Error in Sub: NewCreateIndexADOX"
    Resume ExitHere
End Sub