VBA/Excel/Access/Word/Access/Index
Содержание
- 1 Adding a Multiple-Field Index to an Existing Table
- 2 Adding a Single-Field Index to an Existing Table (Intrinsic constants for the IndexNulls property of the ADOX Index object)
- 3 Adding a Unique Index Based on Two Fields to an Existing Table
- 4 Alter table to delete an Index with SQL command
- 5 Auto-Generate an Index Using VBA
- 6 Creating an Index that Disallows Null Values in the Key with SQL command
- 7 Creating an Index with the Ignore Null Option with SQL command
- 8 Creating a Primary Key Index with Restrictions with SQL command
- 9 Deleting a Field that is a Part of an Index with SQL command
- 10 Deleting an Index with SQL command
- 11 Deleting Indexes from a Table
- 12 Listing Indexes in a Table
Adding a Multiple-Field Index to an Existing Table
<source lang="vb">
Sub Add_MultiFieldIndex()
Dim conn As New ADODB.Connection With conn .Provider = "Microsoft.Jet.OLEDB.4.0" .Open "Data Source=" & CurrentProject.Path & _ "\mydb.mdb" .Execute "CREATE INDEX Location ON Employees (City, Region);" End With conn.Close Set conn = Nothing MsgBox "New index (Location) was created."
End Sub
</source>
Adding a Single-Field Index to an Existing Table (Intrinsic constants for the IndexNulls property of the ADOX Index object)
<source lang="vb">
Constant Name Description adIndexNullsAllow create an index if there is a Null value in the index field (an error will not occur). adIndexNullsDisallow (default value)You cannot create an index if there is a Null in the index for the column (an error will occur). adIndexNullsIgnore create an index if there is a Null in the index field (an error will not occur). adIndexNullsIgnoreAny You can create an index if there is a Null value in the index field.
Sub Add_SingleFieldIndex()
Dim cat As New ADOX.Catalog Dim myTable As New ADOX.Table Dim myIndex As New ADOX.Index On Error GoTo ErrorHandler cat.ActiveConnection = CurrentProject.Connection Set myTable = cat.Tables("vbexTable") With myIndex .Name = "idxDescription" .Unique = False .IndexNulls = adIndexNullsIgnore .Columns.Append "Description" .Columns(0).SortOrder = adSortAscending End With myTable.Indexes.Append myIndex Set cat = Nothing Exit Sub
ErrorHandler:
If Err.Number = -2147217856 Then MsgBox "The "vbexTable" cannot be open.", vbCritical, _ "Close the table" ElseIf Err.Number = -2147217868 Then myTable.Indexes.Delete myIndex.Name Resume 0 Else MsgBox Err.Number & ": " & Err.Description End If
End Sub
</source>
Adding a Unique Index Based on Two Fields to an Existing Table
<source lang="vb">
Sub AddMulti_UniqueIndex()
Dim conn As ADODB.Connection Dim strTable As String Dim strCol As String On Error GoTo ErrorHandler Set conn = CurrentProject.Connection strTable = "myTable" strCol = "Id, Name" conn.Execute "ALTER TABLE " & strTable & " ADD CONSTRAINT multiIdx UNIQUE(" & strCol & ");"
ExitHere:
conn.Close Set conn = Nothing Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description Resume ExitHere
End Sub
</source>
Alter table to delete an Index with SQL command
<source lang="vb">
Sub DeleteIndex()
Dim conn As ADODB.Connection Dim strTable As String Dim strIdx As String On Error GoTo ErrorHandler Set conn = CurrentProject.Connection strTable = "myTable" strIdx = "pKey" conn.Execute "ALTER TABLE " & strTable & " DROP CONSTRAINT " & strIdx & ";"
ExitHere:
conn.Close Set conn = Nothing Exit Sub
ErrorHandler:
MsgBox Err.Number & ":" & Err.Description Resume ExitHere
End Sub
</source>
Auto-Generate an Index Using VBA
<source lang="vb">
Private Sub Worksheet_Activate()
Dim wSheet As Worksheet Dim l As Long l = 1 With Me .Columns(1).ClearContents .Cells(1, 1) = "INDEX" .Cells(1, 1).Name = "Index" End With For Each wSheet In Worksheets If wSheet.Name <> Me.Name Then l = l + 1 With wSheet .Range("A1").Name = "Start" & wSheet.Index .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", SubAddress:= "Index", TextToDisplay:="Back to Index" End With Me.Hyperlinks.Add Anchor:=Me.Cells(l, 1), Address:="",SubAddress:="Start" & wSheet.Index, TextToDisplay:=wSheet.Name End If Next wSheet
End Sub
</source>
Creating an Index that Disallows Null Values in the Key with SQL command
<source lang="vb">
Sub Index_WithDisallowNullOption()
Dim conn As ADODB.Connection Dim strTable As String On Error GoTo ErrorHandler Set conn = CurrentProject.Connection strTable = "myTable" conn.Execute "CREATE INDEX idxSupplierCity ON " & strTable _ & "(SCity) WITH DISALLOW NULL ;"
ExitHere:
conn.Close Set conn = Nothing Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description Resume ExitHere
End Sub
</source>
Creating an Index with the Ignore Null Option with SQL command
<source lang="vb">
Sub Index_WithIgnoreNullOption()
Dim conn As ADODB.Connection Dim strTable As String On Error GoTo ErrorHandler Set conn = CurrentProject.Connection strTable = "myTable" conn.Execute "CREATE INDEX idxSupplierPhone ON " & strTable & "(SPhone) WITH IGNORE NULL ;"
ExitHere:
conn.Close Set conn = Nothing Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description Resume ExitHere
End Sub
</source>
Creating a Primary Key Index with Restrictions with SQL command
<source lang="vb">
Sub Index_WithPrimaryOption()
Dim conn As ADODB.Connection Dim strTable As String On Error GoTo ErrorHandler Set conn = CurrentProject.Connection strTable = "myTable" conn.Execute "CREATE INDEX idxPrimary1 ON " & strTable _ & "(SId) WITH PRIMARY ;"
ExitHere:
conn.Close Set conn = Nothing Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description Resume ExitHere
End Sub
</source>
Deleting a Field that is a Part of an Index with SQL command
<source lang="vb">
Sub DeleteIdxField()
Dim conn As ADODB.Connection Dim strTable As String Dim strCol As String Dim strIdx As String On Error GoTo ErrorHandler Set conn = CurrentProject.Connection strTable = "myTable" strCol = "myName" strIdx = "multiIdx" conn.Execute "ALTER TABLE " & strTable & " DROP CONSTRAINT " & strIdx & ";" conn.Execute "ALTER TABLE " & strTable & " DROP COLUMN " & strCol & ";"
ExitHere:
conn.Close Set conn = Nothing Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description Resume ExitHere
End Sub
</source>
Deleting an Index with SQL command
<source lang="vb">
Sub DeleteIndex()
Dim conn As ADODB.Connection Dim strTable As String On Error GoTo ErrorHandler Set conn = CurrentProject.Connection strTable = "myTable" conn.Execute "DROP INDEX idxSupplierName ON " & strTable & ";"
ExitHere:
conn.Close Set conn = Nothing Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description Resume ExitHere
End Sub
</source>
Deleting Indexes from a Table
<source lang="vb">
Sub Delete_Indexes()
Dim conn As New ADODB.Connection Dim cat As New ADOX.Catalog Dim myTable As New ADOX.Table Dim idx As New ADOX.Index Dim count As Integer With conn .Provider = "Microsoft.Jet.OLEDB.4.0" .Open "Data Source=" & CurrentProject.Path & _ "\mydb.mdb" End With cat.ActiveConnection = conn
Setup:
Set myTable = cat.Tables("Employees") Debug.Print myTable.Indexes.count For Each idx In myTable.Indexes If idx.PrimaryKey <> True Then myTable.Indexes.Delete (idx.Name) GoTo Setup End If Next idx conn.Close Set conn = Nothing MsgBox "All Indexes but Primary Key were deleted."
End Sub
</source>
Listing Indexes in a Table
<source lang="vb">
Sub List_Indexes()
Dim conn As New ADODB.Connection Dim cat As New ADOX.Catalog Dim myTable As New ADOX.Table Dim idx As New ADOX.Index With conn .Provider = "Microsoft.Jet.OLEDB.4.0" .Open "Data Source=" & CurrentProject.Path & _ "\mydb.mdb" End With cat.ActiveConnection = conn Set myTable = cat.Tables("Employees") For Each idx In myTable.Indexes Debug.Print idx.Name Next idx conn.Close Set conn = Nothing MsgBox "Indexes are listed in the Immediate window."
End Sub
</source>