Index property not working 1

[vba317]

I am using access 2003. I am trying to read the index property with limited success. The index property has three modes:
Indexed- No, Yes (Duplicates OK) and Yes No Duplicates. I code will properly pick no with no problem but I cant figure out how to tell the difference between the two yes answers. I know the problem is .Attributes does not switch to a 1 like I had hoped. But I don't know what other property I can use. Any help is appreciated.

If dBase.TableDefs(lTbl).Indexes.Count = 1 Then
.Range("K" & lRow) = "No"
End If
 If dBase.TableDefs(lTbl).Indexes.Count = 2 And dBase.TableDefs(lTbl).Attributes = 0 Then
.Range("K" & lRow) = "Yes No Duplicates"
 End If
 If dBase.TableDefs(lTbl).Indexes.Count = 2 And dBase.TableDefs(lTbl).Attributes = 1 Then
 .Range("K" & lRow) = "Yes (Duplicates OK)"
 End If

 

[Golom]

That information is in Index properties. Try this

Public Sub GetIndexInfo()
Dim idx As DAO.Index
Dim db  As DAO.Database
    
Set db = CurrentDb
Set idx = db.TableDefs("SomeTable").Indexes("SomeIndexName")
    
Debug.Print idx.Name
Debug.Print Space(5) & "Primary      - " & idx.Properties("Primary")
Debug.Print Space(5) & "Unique       - " & idx.Properties("Unique")
Debug.Print Space(5) & "Ignore Nulls - " & idx.Properties("IgnoreNulls")
End Sub

 

[Golom]

There are other properties that you may want to use

Public Sub GetIndexInfo()
Dim idx As DAO.Index
Dim prp As DAO.Property
Dim db  As DAO.Database
Set db = CurrentDb
Debug.Print "Table Name = " & db.TableDefs("SomeTableName").Name
Debug.Print "Index Info"
For Each idx In db.TableDefs("SomeTableName").Indexes
    Debug.Print " "
    For Each prp In idx.Properties
        Debug.Print prp.Name & " - " & prp.Value
    Next
Next
End Sub

Produces

Name - CN_CODE
Unique - False
Clustered - False
Primary - False
Foreign - False
Required - False
IgnoreNulls - True
DistinctCount - 0
 
Name - PrimaryKey
Unique - True
Clustered - False
Primary - True
Foreign - False
Required - True
IgnoreNulls - False
DistinctCount - 0
[blue]etc.[/blue]

 

[vba317]

I tried your code and it did do what you said it would but the results were not what I need. The information this loop gets me is something I need as well so I am going to use it. The property I need is from the general tab when you are in design view of a table, at the bottom of that general tab indexed exists. The indexed field tells you if the individual field in the table is the following three status's: No, Yes No Duplicates, Yes (Duplicates OK).


Tom

 

[Golom]

What is being reported there is just a combination of the field properties above.

To demonstrate that, open the indexes menu in design view and then change the selections in the "Indexed" drop down.

Indexed = "No"
You will see no index set for the field. .

Indexed = "Yes (Duplicates OK)"
You will see Unique set to "No".

Indexed = ""Yes (No Duplicates)"
You will see Unique set to "Yes".

Finally, You will see Primary and Unique set to "Yes" if it is the primary key.

In code

Dim IndexExists As Boolean
Dim IndexText As String
On Error Resume Next
Set idx = db.TableDefs("TableName").Indexes("IndexName")
IndexExists = (Err.Number = 0)
Err.Clear

If Not IndexExists Then
    IndexText = "No"
Else
    If db.TableDefs("TableName").Indexes("IndexName").Properties("Unique").value then
        IndexText = "Yes (Duplicates OK)"
    Else
        IndexText = "Yes (No Duplicates)"
    End If
End If

Note that The "Indexes" entry for a field is a bit misleading for fields in a multi-field index. The "Indexes" entry is valid only for indexes on that specific field and not for multi-field indexes in which it may participate.

 

[vba317]

Sorry I get a compile error when I have tried this .Indexes highlights

 

[Golom]

That was just a scrap of code. Here it is as a function with everything defined

Public Function IndexInfo(TableName As String, IndexName As String) As String
    Dim IndexExists          As Boolean
    Dim IndexText            As String
    Dim db                   As DAO.Database
    
    Set db = CurrentDb
    On Error Resume Next
    Set idx = db.TableDefs(TableName).Indexes(IndexName)
    IndexExists = (Err.Number = 0)
    Err.Clear
    
    If Not IndexExists Then
        IndexInfo = "No"
    Else
        If db.TableDefs("TableName").Indexes("IndexName").Properties("Unique").Value Then
            IndexInfo = "Yes (Duplicates OK)"
        Else
            IndexInfo = "Yes (No Duplicates)"
        End If
    End If
    
End Function

 

[Golom]

Sorry. Still not quite right

Public Function IndexInfo(TableName As String, IndexName As String) As String
    Dim IndexExists          As Boolean
    Dim IndexText            As String
    Dim db                   As DAO.Database
    
    Set db = CurrentDb
    On Error Resume Next
    Set idx = db.TableDefs(TableName).Indexes(IndexName)
    IndexExists = (Err.Number = 0)
    Err.Clear
    
    If Not IndexExists Then
        IndexInfo = "No"
    Else
        If db.TableDefs(TableName).Indexes(IndexName).Properties("Unique").Value Then
            IndexInfo = "Yes (Duplicates OK)"
        Else
            IndexInfo = "Yes (No Duplicates)"
        End If
    End If
    
End Function

 

[Golom]

Hang in There! Eventually I will get it right.

Public Function IndexInfo(TableName As String, IndexName As String) As String
    Dim IndexExists          As Boolean
    Dim IndexText            As String
    Dim db                   As DAO.Database
    
    Set db = CurrentDb
    On Error Resume Next
    Set idx = db.TableDefs(TableName).Indexes(IndexName)
    IndexExists = (Err.Number = 0)
    Err.Clear
    
    If Not IndexExists Then
        IndexInfo = "No"
    Else
        If db.TableDefs(TableName).Indexes(IndexName).Properties("Unique").Value = False Then
            IndexInfo = "Yes (Duplicates OK)"
        Else
            IndexInfo = "Yes (No Duplicates)"
        End If
    End If
    
End Function

 

[vba317]

The code doesnt give me any errors but it still does not work. Since I am trying to get this code to loop through all the tables in my database. I have substituted "Table Name" and "IndexName" with a variable which I have dimmed. Also I still havent been able to get the inputmask property to work. When I hover over idx I get 'nothing'.

Dim strTbl As DAO.TableDefs
Dim strIdx As DAO.Index

 On Error Resume Next
         Set strTbl = Db.TableDefs(lTbl).SourceTableName
         Set strIdx = Db.TableDefs(lTbl).Indexes
         
          'Set idx = Db.TableDefs("TableName").Indexes("IndexName")
           Set idx = DbBase.TableDefs(strTbl).Indexes(strIdx)
        IndexExists = (Err.Number = 0)
        Err.Clear

        If Not IndexExists Then
           goXL.ActiveSheet.Range("K" & lRow) = "No"
    Else
       If Db.TableDefs(strTbl).Indexes(strIdx).Properties("Unique").Value Then
        goXL.ActiveSheet.Range("K" & lRow) = "Yes (Duplicates OK)"
    Else
        goXL.ActiveSheet.Range("K" & lRow) = "Yes (No Duplicates)"
        End If

 

[Golom]

You have a conflict between

[blue]Dim strTbl As DAO.TableDefs[/blue]

and

[blue]Set strTbl = Db.TableDefs(lTbl).SourceTableName[/blue]

[blue]strTable[/blue] is defined as a collection (i.e. TableDefs) but you are attempting to set it to a string (i.e. SourceTableName). Since you have On Error Resume Next you are not seeing the error (Probably "Type Mismatch")

Instead
[blue]Dim strTbl As [red]String[/red][/blue] and
[blue][red]Set[/red] strTbl = Db.TableDefs(lTbl).SourceTableName[/blue]

Note however that "SourceTableName" is defined only for linked tables. It will return "" if the table is local.

 

[vba317]

You are right, I did have a conflict. I did the changes you suggested. I noticed by stepping through the routine that the strTbl = db.TableDefs(lTbl).Fields(lFld).SourceTable does equal the local table that I expect, but the strIdx still equals "Nothing". So the code goes to the error routine and defaults to no. The table is currently set to Yes no duplicates.

Tom

Function GetDataType(D As Field, ByRef lRow As Integer) As String
Dim FieldType As String
Dim DtaType As String
Dim lTbl As Long
Dim lFld As Long
Dim lDFld As String
Dim dBase As DAO.Database
Dim xlApp As Object
Dim wbExcel As Object
Dim fRow As Long
Set dBase = CurrentDb
Dim IndexExists As Boolean
Dim IndexText As String
Dim idx As DAO.Index
Dim prp As DAO.Property
Dim strTbl As String
Dim strIdx As DAO.Index
'Dim strIdx As String
Dim db As DAO.Database
Set db = CurrentDb


On Error Resume Next
                    strTbl = db.TableDefs(lTbl).Fields(lFld).SourceTable
                    strIdx = db.TableDefs(lTbl).Indexes
                    Set idx = db.TableDefs(strTbl).Indexes(strIdx)
                    IndexExists = (Err.Number = 0)
                    Err.Clear

                    If Not IndexExists Then
                     goXL.ActiveSheet.Range("K" & lRow) = "No"
                Else
                    If db.TableDefs(strTbl).Indexes(strIdx).Properties("Unique").Value Then
                    goXL.ActiveSheet.Range("K" & lRow) = "Yes (Duplicates OK)"
                Else
                    goXL.ActiveSheet.Range("K" & lRow) = "Yes (No Duplicates)"
                    End If
                End If

 

[Golom]

Another conflict

[blue]Dim strIdx As DAO.Index[/blue] is defined as an Index object

BUT

[blue]strIdx = db.TableDefs(lTbl).Indexes[/blue] is a collection

You need to take a different approach. You are supplying a Field to the routine and (presumably) you want to know if that field is indexed and, if so, what kind of index it has.

The way it is organized is
[pre]
Tables Collection
Indexes Collection
Index1
Field1
Field2
[blue]etc.[/blue]
Index2
Field1
Field2
[blue]etc.[/blue]
[/pre]
So, and this is only a skeleton

Dim fd As DAO.Field
Dim ix As DAO.Index
Dim FoundField As Boolean
FoundField = FALSE
For Each ix In DAO.TableDefs(lTbl).Indexes   
    If ix.Fields.Count = 1 Then   ' More than one field --> Compound Index 
        For Each fd in ix.Fields
            If fd.Name = D Then   ' Is this the field?
                If ix.Properties("Unique") = FALSE Then
                    goXL.ActiveSheet.Range("K" & lRow) = "Yes (Duplicates OK)"
                Else
                    goXL.ActiveSheet.Range("K" & lRow) = "Yes (No Duplicates)"
                End If
                Foundfield = TRUE
                Exit For
             End If
         Next
         If FoundField Then Exit For
    End If
    If FoundField Then Exit For
Next
if NOT FoundField Then _
    goXL.ActiveSheet.Range("K" & lRow) = "No"

Probably messier than you would like but the problem is that you need to find the field in the list of fields for each index. That's the only way that you know if a field has an index.

 

[vba317]

The code stops at If ix.Properties("Unique") = FALSE Then
When I look at my table the first field is called Extrafield. When I hover over ix.Fields = "+Extrafield", when I hover over fd.Name I see extrafield. The next line causes an error, because the code goes out of the routine. D is empty. So the code is not looping through the properties of the table. I am wondering is it possible that this property is in ADO vs DAO?

 

[Golom]

As I said ... just skeleton code. I just typed this without benefit of being able to run it. [blue]If fd.Name = D Then[/blue] will raise an error because fd.Name is a string and D is an object. They cannot be compared. You probably need

If fd.Name = D[red].Name[/red] Then   ' Is this the field?

"D" is a DAO.Field object and it's default property (which is what you see displayed when you hover over it) is the properties collection. A collection does not have a value so you don't see anything. If hovering displays the word "Nothing" then look at your calling routine. "D" is a calling argument.

DAO is more tightly linked to JET 4.0 than ADO. Most of the properties that we are working with here are not accessible in ADO.

 

[vba317]

Thanks for sticking with me till the end.

Tom