в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:46:42Z

1 версия

Новая страница

==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>

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/Access/Index - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия