Solved

Urgent - Find name of index field in ADO

Posted on 2002-03-04
5
316 Views
Last Modified: 2008-01-09
I am writing an application that needs to use a unique index key that may be in the table that I have built a recordset from. If there isn't a unique index key there will always at least one autocount field.

I am populating a drawing from data of XY coords in the recordset and each element of that drawing needs to have a unique reference back to the table. ie, when I click on an element the correct recordest will be selected. I don't know in advance what the name of the unique index field or the autocount id field.

pseudo code;

Find a unique index key field
 if found return field name
else
 Find a field which is an autoupdate type
 return field name
end if

Please show code, I am using MDAC 2.5
TIA
0
Comment
Question by:mulga
  • 4
5 Comments
 
LVL 17

Expert Comment

by:inthedark
ID: 6838696
You have a problem in that ADO works is supposed to work with many back-end servers. But they forgot to make autonunber/counter/identity fields easy.

Are you using Access back-end or SQL server or what?

As you will be aware each table must have a primary key or ADO won't allow updates.

Here is some code that will find all details for a table.  The Function will pull out all details for a table in a format that you can paste into excel so see which bits you need.

If you are using MDB's you need to add a reference to ADOX, ADO's Securty Extension.

The code to handle ADOX is commented at the base of the subroutine.
0
 
LVL 17

Expert Comment

by:inthedark
ID: 6838697
The fucntion came from a class with many other functions I hope it works a stand alone function.

If you get any problems please inform me.

Public Function GetSchemas(CN As ADODB.Connection, Optional TableName As String) As String

' Returns all of the scheme stuff for a table
' example.
' Clipboard.Clear : Clipboard.SetText ADO.GetSchemas(CN, "MyTable")


Dim SQL As String
Dim RS As ADODB.Recordset
Dim m$
Dim lc As Long
Dim ok
Dim Flags As Long
Dim bn As String
ReDim bin(8) As Long
Dim ctype As String
Dim tb As String

bin(1) = 1
bin(2) = 2
bin(3) = 4
bin(4) = 8
bin(5) = 16
bin(6) = 32
bin(7) = 64
bin(8) = 128

'TABLE_CATALOG
'TABLE_SCHEMA
'INDEX_NAME
'TYPE
'TABLE_NAME


tb = TableName


'adSchemaPrimaryKeys
'adSchemaColumns
'adSchemaIndexes

m$ = "TABLE:" + Chr$(9) + TableName + vbCrLf

Dim desc$

ctype = "TABLES": desc = "adSchemaTables": GoSub GetDets
ctype = "COLS": desc = "adSchemaColumns": GoSub GetDets
ctype = "PKEYS": desc = "adSchemaPrimayKeys": GoSub GetDets
ctype = "INDEX": desc = "adSchemaIndexes": GoSub GetDets
ctype = "IDENT": desc = "adSchemaIndexes": GoSub GetIdent

GetSchemas = m$

Exit Function

GetDets:

m$ = m$ + vbCrLf + desc + vbCrLf + vbCrLf

Select Case ctype
    Case Is = "COLS"
        Set RS = CN.OpenSchema(adSchemaColumns, Array(Empty, Empty, tb, Empty))
    Case Is = "TABLES"
        Set RS = CN.OpenSchema(adSchemaTables, Array(Empty, Empty, TableName))
    Case Is = "PKEYS"
        Set RS = CN.OpenSchema(adSchemaPrimaryKeys, Array(Empty, Empty, TableName))
    Case Is = "INDEX"
        Set RS = CN.OpenSchema(adSchemaIndexes, Array(Empty, Empty, Empty, Empty, tb))
End Select

SQL = Space$(2)

For lc = 0 To RS.Fields.Count - 1
    If lc > 0 Then m$ = m$ + Chr$(9)
    m$ = m$ + CStr(RS.Fields(lc).Name)
Next lc

If ctype = "COLS" Then
    For lc = 1 To 8
        m$ = m$ + Chr(9) + "Flag:" + CStr(bin(lc))
    Next lc
End If

m$ = m$ + vbCrLf

Do While Not RS.EOF

    For lc = 0 To RS.Fields.Count - 1
        If lc > 0 Then m$ = m$ + Chr$(9)
        m$ = m$ + Format(RS.Fields(lc))
    Next lc
   
    If ctype = "COLS" Then
        Flags = RS.Fields("COLUMN_FLAGS")
        bn = String(8, "0")
        For lc = 1 To 8
            If Flags And bin(lc) Then
                Mid(bn, lc, 1) = "1"
            End If
            m$ = m$ + Chr(9) + Mid(bn, lc, 1)
        Next lc
    End If
   
    m$ = m$ + vbCrLf
   
    RS.MoveNext
   
Loop

m$ = m$ + vbCrLf

If False Then

    m$ = m$ + vbCrLf
    RS.Close
   
  '  ok = ADO.OpenRSROOK(CN, RS, "Select * from " + tb + ";")
    For lc = 0 To RS.Fields.Count - 1
        m$ = m$ + CStr(RS.Fields(lc).Name) + Chr(9)
        m$ = m$ + CStr(RS.Fields(lc).Type) + vbCrLf
    Next lc
   
    m$ = m$ + vbCrLf
   
    RS.Close
End If

Return


GetIdent:

If False Then ' this only works for SQL server
    SQL = "SELECT  IDENT_SEED(TABLE_NAME) As Seed,"
    SQL = SQL + " IDENT_INCR(TABLE_NAME) AS Increment,"
    SQL = SQL + " TABLE_NAME"
    SQL = SQL + " From INFORMATION_SCHEMA.TABLES"
    SQL = SQL + " WHERE ((TABLE_NAME='" + tb + "')"
    SQL = SQL + " And (OBJECTPROPERTY(OBJECT_ID(TABLE_NAME), 'TableHasIdentity') = 1)"
    SQL = SQL + " AND (TABLE_TYPE = 'BASE TABLE'))"
    On Error Resume Next
    ok = True
    Set RS = CN.Execute(SQL)
    If Err.Number <> 0 Then
        ok = False
    Else
        If RS.EOF Then
            ok = False
            Set RS = Nothing
        End If
    End If
    If Not ok Then
        m$ = m$ + vbCrLf + vbCrLf + "No SQL Server identity field details available."
    Else
        m$ = m$ + vbCrLf + vbCrLf + "SQL Identity field details:"
        m$ = m$ + "Identity Seed: " + CStr(RS("Seed")) + vbCrLf
        m$ = m$ + "Identity Increment: " + CStr(RS("Increment")) + vbCrLf
        m$ = m$ + vbCrLf
        Set RS = Nothing
    End If
End If


Return

' If using MDB change the above to the following:

 '       Set aCat = New ADOX.Catalog
 '       aCat.ActiveConnection = CN
 '       Set aTab = aCat.Tables(TableName)
 '       For Each aCol In aTab.Columns
 '           If aCol.Properties("AutoIncrement") = True Then
 '               IdentityName = aCol.Name
 '               IdentitySeed = aCol.Properties("Seed")
 '               IdentityIncrement = aCol.Properties("Increment")
 '               Exit For
 '           End If
 '       Next
 '       Set aCol = Nothing
 '       Set aTab = Nothing
 '       Set aCat = Nothing
       
End Function
0
 
LVL 17

Expert Comment

by:inthedark
ID: 6838730
I enhanced the bit of code following GetIdent.  


GetIdent:

    Dim aCat As adox.Catalog
    Dim aTab As adox.Table
    Dim aCol As adox.Column
    Dim IdentityName As String
    Dim IdentitySeed As Long
    Dim IdentityIncrement As Long

If True Then ' change to false if using MDB as this only works for SQL server
   
    SQL = "SELECT  t.TABLE_NAME, c.name AS COLUMN_NAME, IDENT_SEED(t.TABLE_NAME) As Seed, IDENT_INCR(t.TABLE_NAME) As Increment"
    SQL = SQL + " From INFORMATION_SCHEMA.TABLES AS t INNER JOIN sysobjects AS s ON s.name = t.TABLE_NAME"
    SQL = SQL + " INNER JOIN syscolumns AS c ON c.id = s.id"
    SQL = SQL + " Where ((t.TABLE_NAME='" + TableName + "')"
    SQL = SQL + " And (OBJECTPROPERTY(OBJECT_ID(t.TABLE_NAME), 'TableHasIdentity') = 1)"
    SQL = SQL + " AND (t.TABLE_TYPE = 'BASE TABLE')) AND c.autoval IS NOT NULL"
    On Error Resume Next
    ok = False
    Set RS = CN.Execute(SQL)
    If Err.Number <> 0 Then
        ' must be MDB file
    Else
        If RS.EOF Then
            Set RS = Nothing
        Else
            ok = True
            IdentitySeed = ADO.GitNum(RS("Seed"))
            IdentityIncrement = ADO.GitNum(RS("Increment"))
            IdentityName = ADO.Git(RS("COLUMN_NAME"))
        End If
    End If

Else


   
    ' If using MDB change the above to the following:

    Set aCat = New adox.Catalog
    aCat.ActiveConnection = CN
    Set aTab = aCat.Tables(TableName)
    ok = False
    For Each aCol In aTab.Columns
        If aCol.Properties("AutoIncrement") = True Then
            IdentityName = aCol.Name
            IdentitySeed = aCol.Properties("Seed")
            IdentityIncrement = aCol.Properties("Increment")
            ok = True
           
           
            Exit For
        End If
    Next
    Set aCol = Nothing
    Set aTab = Nothing
    Set aCat = Nothing
End If

If Not ok Then
    m$ = m$ + vbCrLf + vbCrLf + "No identity field details available."
Else
    m$ = m$ + vbCrLf + vbCrLf + "SQL Identity field details:"
    m$ = m$ + "Identity Name: " + RS("COLUMN_NAME") + vbCrLf
    m$ = m$ + "Identity Seed: " + CStr(RS("Seed")) + vbCrLf
    m$ = m$ + "Identity Increment: " + CStr(RS("Increment")) + vbCrLf
    m$ = m$ + vbCrLf
    Set RS = Nothing
End If

Return
0
 
LVL 17

Accepted Solution

by:
inthedark earned 200 total points
ID: 6838778
So if you are using Access MDB's you need to create a function like the following:

Create a reference to Microsoft ADO Ext 2.x for DLL & Security.

Open a connection and call the following function like:

CN.Open ' open you ASODB connection
MyAutoNumberField = FindAutoNumberField(CN, "MyTable")

if len(MyAutoNumberField)=0 Then
    msgbox "Panic! You have no counterfield in this table."
end if

Public Function FindAutoNumberField(CN as ADODB.Connection, TableName as String) As String

   Dim aCat As adox.Catalog
   Dim aTab As adox.Table
   Dim aCol As adox.Column
   Dim IdentityName As String
   Dim IdentitySeed As Long
   Dim IdentityIncrement As Long

   Dim Ok as Boolean

   Set aCat = New adox.Catalog
   aCat.ActiveConnection = CN
   Set aTab = aCat.Tables(TableName)
   ok = False
   For Each aCol In aTab.Columns
       If aCol.Properties("AutoIncrement") = True Then
           IdentityName = aCol.Name
           IdentitySeed = aCol.Properties("Seed")
           IdentityIncrement = aCol.Properties("Increment")
           ok = True
           Exit For
       End If
   Next
   Set aCol = Nothing
   Set aTab = Nothing
   Set aCat = Nothing

   If Ok Then
       FindAutoNumberField = Identityname
   else
       FindAutoNumberField = ""
   emd if

End Fucntion
0
 

Author Comment

by:mulga
ID: 6839050
That worked well, thanks
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Suggested Solutions

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now