Sub test()
    On Error GoTo Test_Error
    Dim Cnn As ADODB.Connection
    Set Cnn = New ADODB.Connection
    Dim bResult As Boolean
    With Cnn
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SciezkaBaza & ";"
        .Open
        If .State = adStateOpen Then
            bResult = ADODBCNewIndex(objCn:=Cnn)
            If bResult Then MsgBox "OK"
        End If
    End With

Test_Exit:
    On Error Resume Next
    If Not Cnn Is Nothing Then
        With Cnn
            If .State = adStateOpen Then .Close
        End With
    End If
    Set Cnn = Nothing
    Exit Sub
Test_Error:
    MsgBox "Błąd : ( " & Err.Number & " ) " & Err.Description & vbCrLf & _
           "Procedura : " & "Test", vbExclamation
    Resume Test_Exit
End Sub

Function ADODBCNewIndex(objCn As ADODB.Connection) As Boolean
    On Error GoTo ADODBCNewIndex_Error
    Dim eSQL As String
    eSQL = "CREATE INDEX [nazwisko] ON [ludzie] ([nazwisko])"
    objCn.Execute eSQL
    ADODBCNewIndex = True

ADODBCNewIndex_Exit:
    Exit Function

ADODBCNewIndex_Error:
    ADODBCNewIndex = False
    If objCn.Errors.Count > 0 Then
        MsgBox GetErrorInformation(objCn.Errors) & vbNewLine, vbCritical + vbOKOnly, "ADO Errors"
    Else
        MsgBox "Błąd : ( " & Err.Number & " ) " & Err.Description & vbNewLine & _
               "Procedura : " & "ADODBCNewIndex", vbExclamation
    End If
    Resume ADODBCNewIndex_Exit
End Function

Public Function GetErrorInformation(ByVal oErrorColl As ADODB.Errors) As String
Dim lErrorCount As Long
Dim lErrorIndex As Long
Dim strErr As String
    lErrorCount = oErrorColl.Count
    strErr = "Errors reported by ADO" & vbCrLf
    For lErrorIndex = 0 To (lErrorCount - 1)
        With oErrorColl.Item(lErrorIndex)
            strErr = strErr & "(" & lErrorIndex + 1 & ") " & vbNewLine _
                     & "Error#: " & .Number & vbNewLine _
                     & vbTab & "Source: " & .Source & vbNewLine _
                     & vbTab & "SQL State: " & .SQLState
        End With
    Next
    GetErrorInformation = strErr
End Function

Sub Utwórz_Indeks()
  Const plikMDB = "C:\dane.mdb"
  Const tabela = "tblTabela"
  Const pole = "Pole1"

  Dim cat As New ADOX.Catalog
  Dim tbl As ADOX.Table
  Dim idx As New ADOX.Index

  On Error GoTo Except

  cat.ActiveConnection = "Provider='Microsoft.Jet.OLEDB.4.0';" & _
                         "Data Source='" & plikMDB & "';"

  Set tbl = cat.Tables(tabela)

  With idx
    .Name = pole
    .Columns.Append pole
  End With

  tbl.Indexes.Append idx

Finally:
  Set cat.ActiveConnection = Nothing
  Set cat = Nothing
  Set tbl = Nothing
  Set idx = Nothing
  Exit Sub

Except:
  MsgBox Err.Source & vbNewLine & Err.Number & vbNewLine & _
         Err.Description, , "Error - Sub Utwórz_Indeks"
  Resume Finally
End Sub

eSQL = "CREATE INDEX IF NOT EXISTS ""nazwisko"" ON ""ludzie"" (""nazwisko"") "
rec.Open (eSQL), conn, 3, 1