Source code for Issue Number 6

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Just paste this code into any module (this is the desired way) or form.

'----------------------------------------------------------------------
'
'   Module Name:    basDatabase
'   Written By:     C&D Programming Corp.
'   Create Date:    10/14/97
'   Copyright:      Copyright 1997 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'
'   Purpose:        Create a index in a Microsoft Access database
'
'----------------------------------------------------------------------

Option Explicit

Function DBAddIndex (sDatabaseName As String, sTableName As String, sIndexName As String, sIndexFields As String, bUnique As Integer, bPrimary As Integer) As Integer
    Dim TempIndex As New index  ' Create new Index object.
    Dim DB As Database

    DBAddIndex = False
    On Error Resume Next
    ' It is safest to open this database exclusively to
    ' make these changes.
    Set DB = OpenDatabase(sDatabaseName, True)
    If Err Then
        MsgBox "Can not open database: " & sDatabaseName
        Exit Function
    End If
    TempIndex.Name = sIndexName        ' Set Index properties.
    TempIndex.Fields = sIndexFields    ' "LName; FName"
    TempIndex.Unique = bUnique      ' If index is unique
    TempIndex.Primary = bPrimary    ' If this is the primary index
    ' Append the new Index to the Indexes collection.
    DB.TableDefs(sTableName).Indexes.Append TempIndex
    If Err Then
        MsgBox "Error appending Index to table '" & sTableName & "'"
        GoTo ErrHandler
    End If
    DB.Close
    DBAddIndex = True
    Exit Function

ErrHandler:
    DB.Close
End Function