?
Solved

Urgent - Find name of index field in ADO

Posted on 2002-03-04
5
Medium Priority
?
340 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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 800 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

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses
Course of the Month9 days, 20 hours left to enroll

762 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